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, 2009, 2010 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/>. */
27 #include <sys/types.h> /* some typedefs are used in sys/file.h */
31 #ifdef HAVE_INTTYPES_H
43 /* Only MS-DOS does not define `subprocesses'. */
46 #ifdef HAVE_SOCKETS /* TCP connection support, if kernel can do it */
47 #include <sys/socket.h>
49 #include <netinet/in.h>
50 #include <arpa/inet.h>
52 /* Are local (unix) sockets supported? */
53 #if defined (HAVE_SYS_UN_H)
54 #if !defined (AF_LOCAL) && defined (AF_UNIX)
55 #define AF_LOCAL AF_UNIX
58 #define HAVE_LOCAL_SOCKETS
62 #endif /* HAVE_SOCKETS */
64 #if defined(HAVE_SYS_IOCTL_H)
65 #include <sys/ioctl.h>
66 #if !defined (O_NDELAY) && defined (HAVE_PTYS) && !defined(USG5)
68 #endif /* HAVE_PTYS and no O_NDELAY */
69 #endif /* HAVE_SYS_IOCTL_H */
75 /* Can we use SIOCGIFCONF and/or SIOCGIFADDR */
77 #if defined(HAVE_SYS_IOCTL_H) && defined(HAVE_NET_IF_H)
78 /* sys/ioctl.h may have been included already */
80 #include <sys/ioctl.h>
91 #include <netinet/in.h>
92 #include <arpa/nameser.h>
96 #endif /* subprocesses */
104 #include "character.h"
108 #include "termhooks.h"
109 #include "termopts.h"
110 #include "commands.h"
111 #include "keyboard.h"
112 #include "blockinput.h"
113 #include "dispextern.h"
114 #include "composite.h"
116 #include "sysselect.h"
117 #include "syssignal.h"
120 #if defined (USE_GTK) || defined (HAVE_GCONF)
121 #include "xgselect.h"
122 #endif /* defined (USE_GTK) || defined (HAVE_GCONF) */
126 Lisp_Object Qprocessp
;
127 Lisp_Object Qrun
, Qstop
, Qsignal
;
128 Lisp_Object Qopen
, Qclosed
, Qconnect
, Qfailed
, Qlisten
;
129 Lisp_Object Qlocal
, Qipv4
, Qdatagram
, Qseqpacket
;
130 Lisp_Object Qreal
, Qnetwork
, Qserial
;
134 Lisp_Object QCport
, QCspeed
, QCprocess
;
135 Lisp_Object QCbytesize
, QCstopbits
, QCparity
, Qodd
, Qeven
;
136 Lisp_Object QCflowcontrol
, Qhw
, Qsw
, QCsummary
;
137 Lisp_Object QCbuffer
, QChost
, QCservice
;
138 Lisp_Object QClocal
, QCremote
, QCcoding
;
139 Lisp_Object QCserver
, QCnowait
, QCnoquery
, QCstop
;
140 Lisp_Object QCsentinel
, QClog
, QCoptions
, QCplist
;
141 Lisp_Object Qlast_nonmenu_event
;
142 /* QCfamily is declared and initialized in xfaces.c,
143 QCfilter in keyboard.c. */
144 extern Lisp_Object QCfamily
, QCfilter
;
146 /* Qexit is declared and initialized in eval.c. */
148 /* QCfamily is defined in xfaces.c. */
149 extern Lisp_Object QCfamily
;
150 /* QCfilter is defined in keyboard.c. */
151 extern Lisp_Object QCfilter
;
154 #define NETCONN_P(p) (EQ (XPROCESS (p)->type, Qnetwork))
155 #define NETCONN1_P(p) (EQ ((p)->type, Qnetwork))
156 #define SERIALCONN_P(p) (EQ (XPROCESS (p)->type, Qserial))
157 #define SERIALCONN1_P(p) (EQ ((p)->type, Qserial))
159 #define NETCONN_P(p) 0
160 #define NETCONN1_P(p) 0
161 #define SERIALCONN_P(p) 0
162 #define SERIALCONN1_P(p) 0
163 #endif /* HAVE_SOCKETS */
165 /* Define first descriptor number available for subprocesses. */
166 #define FIRST_PROC_DESC 3
168 /* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
171 #if !defined (SIGCHLD) && defined (SIGCLD)
172 #define SIGCHLD SIGCLD
175 extern char *get_operating_system_release (void);
177 /* Serial processes require termios or Windows. */
178 #if defined (HAVE_TERMIOS) || defined (WINDOWSNT)
183 /* From sysdep.c or w32.c */
184 extern int serial_open (char *port
);
185 extern void serial_configure (struct Lisp_Process
*p
, Lisp_Object contact
);
192 /* t means use pty, nil means use a pipe,
193 maybe other values to come. */
194 static Lisp_Object Vprocess_connection_type
;
196 /* These next two vars are non-static since sysdep.c uses them in the
197 emulation of `select'. */
198 /* Number of events of change of status of a process. */
200 /* Number of events for which the user or sentinel has been notified. */
203 /* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
205 #ifdef BROKEN_NON_BLOCKING_CONNECT
206 #undef NON_BLOCKING_CONNECT
208 #ifndef NON_BLOCKING_CONNECT
211 #if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
212 #if defined (O_NONBLOCK) || defined (O_NDELAY)
213 #if defined (EWOULDBLOCK) || defined (EINPROGRESS)
214 #define NON_BLOCKING_CONNECT
215 #endif /* EWOULDBLOCK || EINPROGRESS */
216 #endif /* O_NONBLOCK || O_NDELAY */
217 #endif /* HAVE_GETPEERNAME || GNU_LINUX */
218 #endif /* HAVE_SELECT */
219 #endif /* HAVE_SOCKETS */
220 #endif /* NON_BLOCKING_CONNECT */
221 #endif /* BROKEN_NON_BLOCKING_CONNECT */
223 /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
224 this system. We need to read full packets, so we need a
225 "non-destructive" select. So we require either native select,
226 or emulation of select using FIONREAD. */
228 #ifdef BROKEN_DATAGRAM_SOCKETS
229 #undef DATAGRAM_SOCKETS
231 #ifndef DATAGRAM_SOCKETS
233 #if defined (HAVE_SELECT) || defined (FIONREAD)
234 #if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
235 #define DATAGRAM_SOCKETS
236 #endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
237 #endif /* HAVE_SELECT || FIONREAD */
238 #endif /* HAVE_SOCKETS */
239 #endif /* DATAGRAM_SOCKETS */
240 #endif /* BROKEN_DATAGRAM_SOCKETS */
242 #if defined HAVE_LOCAL_SOCKETS && defined DATAGRAM_SOCKETS
243 # define HAVE_SEQPACKET
246 #if !defined (ADAPTIVE_READ_BUFFERING) && !defined (NO_ADAPTIVE_READ_BUFFERING)
247 #ifdef EMACS_HAS_USECS
248 #define ADAPTIVE_READ_BUFFERING
252 #ifdef ADAPTIVE_READ_BUFFERING
253 #define READ_OUTPUT_DELAY_INCREMENT 10000
254 #define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
255 #define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
257 /* Number of processes which have a non-zero read_output_delay,
258 and therefore might be delayed for adaptive read buffering. */
260 static int process_output_delay_count
;
262 /* Non-zero if any process has non-nil read_output_skip. */
264 static int process_output_skip
;
266 /* Non-nil means to delay reading process output to improve buffering.
267 A value of t means that delay is reset after each send, any other
268 non-nil value does not reset the delay. A value of nil disables
269 adaptive read buffering completely. */
270 static Lisp_Object Vprocess_adaptive_read_buffering
;
272 #define process_output_delay_count 0
275 static int keyboard_bit_set (SELECT_TYPE
*);
276 static void deactivate_process (Lisp_Object
);
277 static void status_notify (struct Lisp_Process
*);
278 static int read_process_output (Lisp_Object
, int);
279 static void create_pty (Lisp_Object
);
281 /* If we support a window system, turn on the code to poll periodically
282 to detect C-g. It isn't actually used when doing interrupt input. */
283 #ifdef HAVE_WINDOW_SYSTEM
284 #define POLL_FOR_INPUT
287 static Lisp_Object
get_process (register Lisp_Object name
);
288 static void exec_sentinel (Lisp_Object proc
, Lisp_Object reason
);
290 #endif /* subprocesses */
292 extern int timers_run
;
294 Lisp_Object Qeuid
, Qegid
, Qcomm
, Qstate
, Qppid
, Qpgrp
, Qsess
, Qttname
, Qtpgid
;
295 Lisp_Object Qminflt
, Qmajflt
, Qcminflt
, Qcmajflt
, Qutime
, Qstime
, Qcstime
;
296 Lisp_Object Qcutime
, Qpri
, Qnice
, Qthcount
, Qstart
, Qvsize
, Qrss
, Qargs
;
297 Lisp_Object Quser
, Qgroup
, Qetime
, Qpcpu
, Qpmem
, Qtime
, Qctime
;
298 Lisp_Object QCname
, QCtype
;
300 /* Non-zero if keyboard input is on hold, zero otherwise. */
302 static int kbd_is_on_hold
;
304 /* Nonzero means delete a process right away if it exits. */
305 static int delete_exited_processes
;
309 /* Mask of bits indicating the descriptors that we wait for input on. */
311 static SELECT_TYPE input_wait_mask
;
313 /* Mask that excludes keyboard input descriptor(s). */
315 static SELECT_TYPE non_keyboard_wait_mask
;
317 /* Mask that excludes process input descriptor(s). */
319 static SELECT_TYPE non_process_wait_mask
;
321 /* Mask for the gpm mouse input descriptor. */
323 static SELECT_TYPE gpm_wait_mask
;
325 #ifdef NON_BLOCKING_CONNECT
326 /* Mask of bits indicating the descriptors that we wait for connect to
327 complete on. Once they complete, they are removed from this mask
328 and added to the input_wait_mask and non_keyboard_wait_mask. */
330 static SELECT_TYPE connect_wait_mask
;
332 /* Number of bits set in connect_wait_mask. */
333 static int num_pending_connects
;
335 #define IF_NON_BLOCKING_CONNECT(s) s
336 #else /* NON_BLOCKING_CONNECT */
337 #define IF_NON_BLOCKING_CONNECT(s)
338 #endif /* NON_BLOCKING_CONNECT */
340 /* The largest descriptor currently in use for a process object. */
341 static int max_process_desc
;
343 /* The largest descriptor currently in use for keyboard input. */
344 static int max_keyboard_desc
;
346 /* The largest descriptor currently in use for gpm mouse input. */
347 static int max_gpm_desc
;
349 /* Indexed by descriptor, gives the process (if any) for that descriptor */
350 Lisp_Object chan_process
[MAXDESC
];
352 /* Alist of elements (NAME . PROCESS) */
353 Lisp_Object Vprocess_alist
;
355 /* Buffered-ahead input char from process, indexed by channel.
356 -1 means empty (no char is buffered).
357 Used on sys V where the only way to tell if there is any
358 output from the process is to read at least one char.
359 Always -1 on systems that support FIONREAD. */
361 /* Don't make static; need to access externally. */
362 int proc_buffered_char
[MAXDESC
];
364 /* Table of `struct coding-system' for each process. */
365 static struct coding_system
*proc_decode_coding_system
[MAXDESC
];
366 static struct coding_system
*proc_encode_coding_system
[MAXDESC
];
368 #ifdef DATAGRAM_SOCKETS
369 /* Table of `partner address' for datagram sockets. */
370 struct sockaddr_and_len
{
373 } datagram_address
[MAXDESC
];
374 #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
375 #define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XPROCESS (proc)->infd].sa != 0)
377 #define DATAGRAM_CHAN_P(chan) (0)
378 #define DATAGRAM_CONN_P(proc) (0)
381 /* Maximum number of bytes to send to a pty without an eof. */
382 static int pty_max_bytes
;
384 /* Nonzero means don't run process sentinels. This is used
386 int inhibit_sentinels
;
392 /* The file name of the pty opened by allocate_pty. */
394 static char pty_name
[24];
397 /* Compute the Lisp form of the process status, p->status, from
398 the numeric status that was returned by `wait'. */
400 static Lisp_Object
status_convert (int);
403 update_status (struct Lisp_Process
*p
)
405 eassert (p
->raw_status_new
);
406 p
->status
= status_convert (p
->raw_status
);
407 p
->raw_status_new
= 0;
410 /* Convert a process status word in Unix format to
411 the list that we use internally. */
414 status_convert (int w
)
417 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
418 else if (WIFEXITED (w
))
419 return Fcons (Qexit
, Fcons (make_number (WRETCODE (w
)),
420 WCOREDUMP (w
) ? Qt
: Qnil
));
421 else if (WIFSIGNALED (w
))
422 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
423 WCOREDUMP (w
) ? Qt
: Qnil
));
428 /* Given a status-list, extract the three pieces of information
429 and store them individually through the three pointers. */
432 decode_status (Lisp_Object l
, Lisp_Object
*symbol
, int *code
, int *coredump
)
446 *code
= XFASTINT (XCAR (tem
));
448 *coredump
= !NILP (tem
);
452 /* Return a string describing a process status list. */
455 status_message (struct Lisp_Process
*p
)
457 Lisp_Object status
= p
->status
;
460 Lisp_Object string
, string2
;
462 decode_status (status
, &symbol
, &code
, &coredump
);
464 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
467 synchronize_system_messages_locale ();
468 signame
= strsignal (code
);
470 string
= build_string ("unknown");
475 string
= make_unibyte_string (signame
, strlen (signame
));
476 if (! NILP (Vlocale_coding_system
))
477 string
= (code_convert_string_norecord
478 (string
, Vlocale_coding_system
, 0));
479 c1
= STRING_CHAR ((char *) SDATA (string
));
482 Faset (string
, make_number (0), make_number (c2
));
484 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
485 return concat2 (string
, string2
);
487 else if (EQ (symbol
, Qexit
))
490 return build_string (code
== 0 ? "deleted\n" : "connection broken by remote peer\n");
492 return build_string ("finished\n");
493 string
= Fnumber_to_string (make_number (code
));
494 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
495 return concat3 (build_string ("exited abnormally with code "),
498 else if (EQ (symbol
, Qfailed
))
500 string
= Fnumber_to_string (make_number (code
));
501 string2
= build_string ("\n");
502 return concat3 (build_string ("failed with code "),
506 return Fcopy_sequence (Fsymbol_name (symbol
));
511 /* Open an available pty, returning a file descriptor.
512 Return -1 on failure.
513 The file name of the terminal corresponding to the pty
514 is left in the variable pty_name. */
525 for (c
= FIRST_PTY_LETTER
; c
<= 'z'; c
++)
526 for (i
= 0; i
< 16; i
++)
529 struct stat stb
; /* Used in some PTY_OPEN. */
530 #ifdef PTY_NAME_SPRINTF
533 sprintf (pty_name
, "/dev/pty%c%x", c
, i
);
534 #endif /* no PTY_NAME_SPRINTF */
538 #else /* no PTY_OPEN */
540 { /* Some systems name their pseudoterminals so that there are gaps in
541 the usual sequence - for example, on HP9000/S700 systems, there
542 are no pseudoterminals with names ending in 'f'. So we wait for
543 three failures in a row before deciding that we've reached the
545 int failed_count
= 0;
547 if (stat (pty_name
, &stb
) < 0)
550 if (failed_count
>= 3)
557 fd
= emacs_open (pty_name
, O_RDWR
| O_NONBLOCK
, 0);
559 fd
= emacs_open (pty_name
, O_RDWR
| O_NDELAY
, 0);
562 #endif /* no PTY_OPEN */
566 /* check to make certain that both sides are available
567 this avoids a nasty yet stupid bug in rlogins */
568 #ifdef PTY_TTY_NAME_SPRINTF
571 sprintf (pty_name
, "/dev/tty%c%x", c
, i
);
572 #endif /* no PTY_TTY_NAME_SPRINTF */
573 if (access (pty_name
, 6) != 0)
588 #endif /* HAVE_PTYS */
591 make_process (Lisp_Object name
)
593 register Lisp_Object val
, tem
, name1
;
594 register struct Lisp_Process
*p
;
598 p
= allocate_process ();
606 p
->raw_status_new
= 0;
608 p
->mark
= Fmake_marker ();
609 p
->kill_without_query
= 0;
611 #ifdef ADAPTIVE_READ_BUFFERING
612 p
->adaptive_read_buffering
= 0;
613 p
->read_output_delay
= 0;
614 p
->read_output_skip
= 0;
617 /* If name is already in use, modify it until it is unused. */
622 tem
= Fget_process (name1
);
623 if (NILP (tem
)) break;
624 sprintf (suffix
, "<%d>", i
);
625 name1
= concat2 (name
, build_string (suffix
));
629 XSETPROCESS (val
, p
);
630 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
635 remove_process (register Lisp_Object proc
)
637 register Lisp_Object pair
;
639 pair
= Frassq (proc
, Vprocess_alist
);
640 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
642 deactivate_process (proc
);
645 /* Setup coding systems of PROCESS. */
648 setup_process_coding_systems (Lisp_Object process
)
650 struct Lisp_Process
*p
= XPROCESS (process
);
652 int outch
= p
->outfd
;
653 Lisp_Object coding_system
;
655 if (inch
< 0 || outch
< 0)
658 if (!proc_decode_coding_system
[inch
])
659 proc_decode_coding_system
[inch
]
660 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
661 coding_system
= p
->decode_coding_system
;
662 if (! NILP (p
->filter
))
664 else if (BUFFERP (p
->buffer
))
666 if (NILP (XBUFFER (p
->buffer
)->enable_multibyte_characters
))
667 coding_system
= raw_text_coding_system (coding_system
);
669 setup_coding_system (coding_system
, proc_decode_coding_system
[inch
]);
671 if (!proc_encode_coding_system
[outch
])
672 proc_encode_coding_system
[outch
]
673 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
674 setup_coding_system (p
->encode_coding_system
,
675 proc_encode_coding_system
[outch
]);
678 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
679 doc
: /* Return t if OBJECT is a process. */)
682 return PROCESSP (object
) ? Qt
: Qnil
;
685 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
686 doc
: /* Return the process named NAME, or nil if there is none. */)
687 (register Lisp_Object name
)
692 return Fcdr (Fassoc (name
, Vprocess_alist
));
695 /* This is how commands for the user decode process arguments. It
696 accepts a process, a process name, a buffer, a buffer name, or nil.
697 Buffers denote the first process in the buffer, and nil denotes the
701 get_process (register Lisp_Object name
)
703 register Lisp_Object proc
, obj
;
706 obj
= Fget_process (name
);
708 obj
= Fget_buffer (name
);
710 error ("Process %s does not exist", SDATA (name
));
712 else if (NILP (name
))
713 obj
= Fcurrent_buffer ();
717 /* Now obj should be either a buffer object or a process object.
721 proc
= Fget_buffer_process (obj
);
723 error ("Buffer %s has no process", SDATA (XBUFFER (obj
)->name
));
735 /* Fdelete_process promises to immediately forget about the process, but in
736 reality, Emacs needs to remember those processes until they have been
737 treated by sigchld_handler; otherwise this handler would consider the
738 process as being synchronous and say that the synchronous process is
740 static Lisp_Object deleted_pid_list
;
743 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
744 doc
: /* Delete PROCESS: kill it and forget about it immediately.
745 PROCESS may be a process, a buffer, the name of a process or buffer, or
746 nil, indicating the current buffer's process. */)
747 (register Lisp_Object process
)
749 register struct Lisp_Process
*p
;
751 process
= get_process (process
);
752 p
= XPROCESS (process
);
754 p
->raw_status_new
= 0;
755 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
757 p
->status
= Fcons (Qexit
, Fcons (make_number (0), Qnil
));
758 p
->tick
= ++process_tick
;
760 redisplay_preserve_echo_area (13);
762 else if (p
->infd
>= 0)
766 /* Assignment to EMACS_INT stops GCC whining about limited range
768 EMACS_INT pid
= p
->pid
;
770 /* No problem storing the pid here, as it is still in Vprocess_alist. */
771 deleted_pid_list
= Fcons (make_fixnum_or_float (pid
),
772 /* GC treated elements set to nil. */
773 Fdelq (Qnil
, deleted_pid_list
));
774 /* If the process has already signaled, remove it from the list. */
775 if (p
->raw_status_new
)
778 if (CONSP (p
->status
))
779 symbol
= XCAR (p
->status
);
780 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
782 = Fdelete (make_fixnum_or_float (pid
), deleted_pid_list
);
786 Fkill_process (process
, Qnil
);
787 /* Do this now, since remove_process will make sigchld_handler do nothing. */
789 = Fcons (Qsignal
, Fcons (make_number (SIGKILL
), Qnil
));
790 p
->tick
= ++process_tick
;
792 redisplay_preserve_echo_area (13);
795 remove_process (process
);
799 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
800 doc
: /* Return the status of PROCESS.
801 The returned value is one of the following symbols:
802 run -- for a process that is running.
803 stop -- for a process stopped but continuable.
804 exit -- for a process that has exited.
805 signal -- for a process that has got a fatal signal.
806 open -- for a network stream connection that is open.
807 listen -- for a network stream server that is listening.
808 closed -- for a network stream connection that is closed.
809 connect -- when waiting for a non-blocking connection to complete.
810 failed -- when a non-blocking connection has failed.
811 nil -- if arg is a process name and no such process exists.
812 PROCESS may be a process, a buffer, the name of a process, or
813 nil, indicating the current buffer's process. */)
814 (register Lisp_Object process
)
816 register struct Lisp_Process
*p
;
817 register Lisp_Object status
;
819 if (STRINGP (process
))
820 process
= Fget_process (process
);
822 process
= get_process (process
);
827 p
= XPROCESS (process
);
828 if (p
->raw_status_new
)
832 status
= XCAR (status
);
833 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
835 if (EQ (status
, Qexit
))
837 else if (EQ (p
->command
, Qt
))
839 else if (EQ (status
, Qrun
))
845 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
847 doc
: /* Return the exit status of PROCESS or the signal number that killed it.
848 If PROCESS has not yet exited or died, return 0. */)
849 (register Lisp_Object process
)
851 CHECK_PROCESS (process
);
852 if (XPROCESS (process
)->raw_status_new
)
853 update_status (XPROCESS (process
));
854 if (CONSP (XPROCESS (process
)->status
))
855 return XCAR (XCDR (XPROCESS (process
)->status
));
856 return make_number (0);
859 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
860 doc
: /* Return the process id of PROCESS.
861 This is the pid of the external process which PROCESS uses or talks to.
862 For a network connection, this value is nil. */)
863 (register Lisp_Object process
)
865 /* Assignment to EMACS_INT stops GCC whining about limited range of
869 CHECK_PROCESS (process
);
870 pid
= XPROCESS (process
)->pid
;
871 return (pid
? make_fixnum_or_float (pid
) : Qnil
);
874 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
875 doc
: /* Return the name of PROCESS, as a string.
876 This is the name of the program invoked in PROCESS,
877 possibly modified to make it unique among process names. */)
878 (register Lisp_Object process
)
880 CHECK_PROCESS (process
);
881 return XPROCESS (process
)->name
;
884 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
885 doc
: /* Return the command that was executed to start PROCESS.
886 This is a list of strings, the first string being the program executed
887 and the rest of the strings being the arguments given to it.
888 For a network or serial process, this is nil (process is running) or t
889 \(process is stopped). */)
890 (register Lisp_Object process
)
892 CHECK_PROCESS (process
);
893 return XPROCESS (process
)->command
;
896 DEFUN ("process-tty-name", Fprocess_tty_name
, Sprocess_tty_name
, 1, 1, 0,
897 doc
: /* Return the name of the terminal PROCESS uses, or nil if none.
898 This is the terminal that the process itself reads and writes on,
899 not the name of the pty that Emacs uses to talk with that terminal. */)
900 (register Lisp_Object process
)
902 CHECK_PROCESS (process
);
903 return XPROCESS (process
)->tty_name
;
906 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
908 doc
: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). */)
909 (register Lisp_Object process
, Lisp_Object buffer
)
911 struct Lisp_Process
*p
;
913 CHECK_PROCESS (process
);
915 CHECK_BUFFER (buffer
);
916 p
= XPROCESS (process
);
918 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
919 p
->childp
= Fplist_put (p
->childp
, QCbuffer
, buffer
);
920 setup_process_coding_systems (process
);
924 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
926 doc
: /* Return the buffer PROCESS is associated with.
927 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */)
928 (register Lisp_Object process
)
930 CHECK_PROCESS (process
);
931 return XPROCESS (process
)->buffer
;
934 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
936 doc
: /* Return the marker for the end of the last output from PROCESS. */)
937 (register Lisp_Object process
)
939 CHECK_PROCESS (process
);
940 return XPROCESS (process
)->mark
;
943 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
945 doc
: /* Give PROCESS the filter function FILTER; nil means no filter.
946 A value of t means stop accepting output from the process.
948 When a process has a filter, its buffer is not used for output.
949 Instead, each time it does output, the entire string of output is
950 passed to the filter.
952 The filter gets two arguments: the process and the string of output.
953 The string argument is normally a multibyte string, except:
954 - if the process' input coding system is no-conversion or raw-text,
955 it is a unibyte string (the non-converted input), or else
956 - if `default-enable-multibyte-characters' is nil, it is a unibyte
957 string (the result of converting the decoded input multibyte
958 string to unibyte with `string-make-unibyte'). */)
959 (register Lisp_Object process
, Lisp_Object filter
)
961 struct Lisp_Process
*p
;
963 CHECK_PROCESS (process
);
964 p
= XPROCESS (process
);
966 /* Don't signal an error if the process' input file descriptor
967 is closed. This could make debugging Lisp more difficult,
968 for example when doing something like
970 (setq process (start-process ...))
972 (set-process-filter process ...) */
976 if (EQ (filter
, Qt
) && !EQ (p
->status
, Qlisten
))
978 FD_CLR (p
->infd
, &input_wait_mask
);
979 FD_CLR (p
->infd
, &non_keyboard_wait_mask
);
981 else if (EQ (p
->filter
, Qt
)
982 /* Network or serial process not stopped: */
983 && !EQ (p
->command
, Qt
))
985 FD_SET (p
->infd
, &input_wait_mask
);
986 FD_SET (p
->infd
, &non_keyboard_wait_mask
);
991 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
992 p
->childp
= Fplist_put (p
->childp
, QCfilter
, filter
);
993 setup_process_coding_systems (process
);
997 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
999 doc
: /* Returns the filter function of PROCESS; nil if none.
1000 See `set-process-filter' for more info on filter functions. */)
1001 (register Lisp_Object process
)
1003 CHECK_PROCESS (process
);
1004 return XPROCESS (process
)->filter
;
1007 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
1009 doc
: /* Give PROCESS the sentinel SENTINEL; nil for none.
1010 The sentinel is called as a function when the process changes state.
1011 It gets two arguments: the process, and a string describing the change. */)
1012 (register Lisp_Object process
, Lisp_Object sentinel
)
1014 struct Lisp_Process
*p
;
1016 CHECK_PROCESS (process
);
1017 p
= XPROCESS (process
);
1019 p
->sentinel
= sentinel
;
1020 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
1021 p
->childp
= Fplist_put (p
->childp
, QCsentinel
, sentinel
);
1025 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
1027 doc
: /* Return the sentinel of PROCESS; nil if none.
1028 See `set-process-sentinel' for more info on sentinels. */)
1029 (register Lisp_Object process
)
1031 CHECK_PROCESS (process
);
1032 return XPROCESS (process
)->sentinel
;
1035 DEFUN ("set-process-window-size", Fset_process_window_size
,
1036 Sset_process_window_size
, 3, 3, 0,
1037 doc
: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
1038 (register Lisp_Object process
, Lisp_Object height
, Lisp_Object width
)
1040 CHECK_PROCESS (process
);
1041 CHECK_NATNUM (height
);
1042 CHECK_NATNUM (width
);
1044 if (XPROCESS (process
)->infd
< 0
1045 || set_window_size (XPROCESS (process
)->infd
,
1046 XINT (height
), XINT (width
)) <= 0)
1052 DEFUN ("set-process-inherit-coding-system-flag",
1053 Fset_process_inherit_coding_system_flag
,
1054 Sset_process_inherit_coding_system_flag
, 2, 2, 0,
1055 doc
: /* Determine whether buffer of PROCESS will inherit coding-system.
1056 If the second argument FLAG is non-nil, then the variable
1057 `buffer-file-coding-system' of the buffer associated with PROCESS
1058 will be bound to the value of the coding system used to decode
1061 This is useful when the coding system specified for the process buffer
1062 leaves either the character code conversion or the end-of-line conversion
1063 unspecified, or if the coding system used to decode the process output
1064 is more appropriate for saving the process buffer.
1066 Binding the variable `inherit-process-coding-system' to non-nil before
1067 starting the process is an alternative way of setting the inherit flag
1068 for the process which will run. */)
1069 (register Lisp_Object process
, Lisp_Object flag
)
1071 CHECK_PROCESS (process
);
1072 XPROCESS (process
)->inherit_coding_system_flag
= !NILP (flag
);
1076 DEFUN ("set-process-query-on-exit-flag",
1077 Fset_process_query_on_exit_flag
, Sset_process_query_on_exit_flag
,
1079 doc
: /* Specify if query is needed for PROCESS when Emacs is exited.
1080 If the second argument FLAG is non-nil, Emacs will query the user before
1081 exiting or killing a buffer if PROCESS is running. */)
1082 (register Lisp_Object process
, Lisp_Object flag
)
1084 CHECK_PROCESS (process
);
1085 XPROCESS (process
)->kill_without_query
= NILP (flag
);
1089 DEFUN ("process-query-on-exit-flag",
1090 Fprocess_query_on_exit_flag
, Sprocess_query_on_exit_flag
,
1092 doc
: /* Return the current value of query-on-exit flag for PROCESS. */)
1093 (register Lisp_Object process
)
1095 CHECK_PROCESS (process
);
1096 return (XPROCESS (process
)->kill_without_query
? Qnil
: Qt
);
1099 #ifdef DATAGRAM_SOCKETS
1100 Lisp_Object
Fprocess_datagram_address (Lisp_Object process
);
1103 DEFUN ("process-contact", Fprocess_contact
, Sprocess_contact
,
1105 doc
: /* Return the contact info of PROCESS; t for a real child.
1106 For a network or serial connection, the value depends on the optional
1107 KEY arg. If KEY is nil, value is a cons cell of the form (HOST
1108 SERVICE) for a network connection or (PORT SPEED) for a serial
1109 connection. If KEY is t, the complete contact information for the
1110 connection is returned, else the specific value for the keyword KEY is
1111 returned. See `make-network-process' or `make-serial-process' for a
1112 list of keywords. */)
1113 (register Lisp_Object process
, Lisp_Object key
)
1115 Lisp_Object contact
;
1117 CHECK_PROCESS (process
);
1118 contact
= XPROCESS (process
)->childp
;
1120 #ifdef DATAGRAM_SOCKETS
1121 if (DATAGRAM_CONN_P (process
)
1122 && (EQ (key
, Qt
) || EQ (key
, QCremote
)))
1123 contact
= Fplist_put (contact
, QCremote
,
1124 Fprocess_datagram_address (process
));
1127 if ((!NETCONN_P (process
) && !SERIALCONN_P (process
)) || EQ (key
, Qt
))
1129 if (NILP (key
) && NETCONN_P (process
))
1130 return Fcons (Fplist_get (contact
, QChost
),
1131 Fcons (Fplist_get (contact
, QCservice
), Qnil
));
1132 if (NILP (key
) && SERIALCONN_P (process
))
1133 return Fcons (Fplist_get (contact
, QCport
),
1134 Fcons (Fplist_get (contact
, QCspeed
), Qnil
));
1135 return Fplist_get (contact
, key
);
1138 DEFUN ("process-plist", Fprocess_plist
, Sprocess_plist
,
1140 doc
: /* Return the plist of PROCESS. */)
1141 (register Lisp_Object process
)
1143 CHECK_PROCESS (process
);
1144 return XPROCESS (process
)->plist
;
1147 DEFUN ("set-process-plist", Fset_process_plist
, Sset_process_plist
,
1149 doc
: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
1150 (register Lisp_Object process
, Lisp_Object plist
)
1152 CHECK_PROCESS (process
);
1155 XPROCESS (process
)->plist
= plist
;
1159 #if 0 /* Turned off because we don't currently record this info
1160 in the process. Perhaps add it. */
1161 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
1162 doc
: /* Return the connection type of PROCESS.
1163 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1164 a socket connection. */)
1165 (Lisp_Object process
)
1167 return XPROCESS (process
)->type
;
1171 DEFUN ("process-type", Fprocess_type
, Sprocess_type
, 1, 1, 0,
1172 doc
: /* Return the connection type of PROCESS.
1173 The value is either the symbol `real', `network', or `serial'.
1174 PROCESS may be a process, a buffer, the name of a process or buffer, or
1175 nil, indicating the current buffer's process. */)
1176 (Lisp_Object process
)
1179 proc
= get_process (process
);
1180 return XPROCESS (proc
)->type
;
1184 DEFUN ("format-network-address", Fformat_network_address
, Sformat_network_address
,
1186 doc
: /* Convert network ADDRESS from internal format to a string.
1187 A 4 or 5 element vector represents an IPv4 address (with port number).
1188 An 8 or 9 element vector represents an IPv6 address (with port number).
1189 If optional second argument OMIT-PORT is non-nil, don't include a port
1190 number in the string, even when present in ADDRESS.
1191 Returns nil if format of ADDRESS is invalid. */)
1192 (Lisp_Object address
, Lisp_Object omit_port
)
1197 if (STRINGP (address
)) /* AF_LOCAL */
1200 if (VECTORP (address
)) /* AF_INET or AF_INET6 */
1202 register struct Lisp_Vector
*p
= XVECTOR (address
);
1203 Lisp_Object args
[10];
1206 if (p
->size
== 4 || (p
->size
== 5 && !NILP (omit_port
)))
1208 args
[0] = build_string ("%d.%d.%d.%d");
1211 else if (p
->size
== 5)
1213 args
[0] = build_string ("%d.%d.%d.%d:%d");
1216 else if (p
->size
== 8 || (p
->size
== 9 && !NILP (omit_port
)))
1218 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
1221 else if (p
->size
== 9)
1223 args
[0] = build_string ("[%x:%x:%x:%x:%x:%x:%x:%x]:%d");
1229 for (i
= 0; i
< nargs
; i
++)
1231 EMACS_INT element
= XINT (p
->contents
[i
]);
1233 if (element
< 0 || element
> 65535)
1236 if (nargs
<= 5 /* IPv4 */
1237 && i
< 4 /* host, not port */
1241 args
[i
+1] = p
->contents
[i
];
1244 return Fformat (nargs
+1, args
);
1247 if (CONSP (address
))
1249 Lisp_Object args
[2];
1250 args
[0] = build_string ("<Family %d>");
1251 args
[1] = Fcar (address
);
1252 return Fformat (2, args
);
1260 list_processes_1 (Lisp_Object query_only
)
1262 register Lisp_Object tail
, tem
;
1263 Lisp_Object proc
, minspace
, tem1
;
1264 register struct Lisp_Process
*p
;
1266 int w_proc
, w_buffer
, w_tty
;
1268 Lisp_Object i_status
, i_buffer
, i_tty
, i_command
;
1270 w_proc
= 4; /* Proc */
1271 w_buffer
= 6; /* Buffer */
1272 w_tty
= 0; /* Omit if no ttys */
1274 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
1278 proc
= Fcdr (XCAR (tail
));
1279 p
= XPROCESS (proc
);
1282 if (!NILP (query_only
) && p
->kill_without_query
)
1284 if (STRINGP (p
->name
)
1285 && ( i
= SCHARS (p
->name
), (i
> w_proc
)))
1287 if (!NILP (p
->buffer
))
1289 if (NILP (XBUFFER (p
->buffer
)->name
))
1292 w_buffer
= 8; /* (Killed) */
1294 else if ((i
= SCHARS (XBUFFER (p
->buffer
)->name
), (i
> w_buffer
)))
1297 if (STRINGP (p
->tty_name
)
1298 && (i
= SCHARS (p
->tty_name
), (i
> w_tty
)))
1302 XSETFASTINT (i_status
, w_proc
+ 1);
1303 XSETFASTINT (i_buffer
, XFASTINT (i_status
) + 9);
1306 XSETFASTINT (i_tty
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1307 XSETFASTINT (i_command
, XFASTINT (i_tty
) + w_tty
+ 1);
1312 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1315 XSETFASTINT (minspace
, 1);
1317 set_buffer_internal (XBUFFER (Vstandard_output
));
1318 current_buffer
->undo_list
= Qt
;
1320 current_buffer
->truncate_lines
= Qt
;
1322 write_string ("Proc", -1);
1323 Findent_to (i_status
, minspace
); write_string ("Status", -1);
1324 Findent_to (i_buffer
, minspace
); write_string ("Buffer", -1);
1327 Findent_to (i_tty
, minspace
); write_string ("Tty", -1);
1329 Findent_to (i_command
, minspace
); write_string ("Command", -1);
1330 write_string ("\n", -1);
1332 write_string ("----", -1);
1333 Findent_to (i_status
, minspace
); write_string ("------", -1);
1334 Findent_to (i_buffer
, minspace
); write_string ("------", -1);
1337 Findent_to (i_tty
, minspace
); write_string ("---", -1);
1339 Findent_to (i_command
, minspace
); write_string ("-------", -1);
1340 write_string ("\n", -1);
1342 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
1346 proc
= Fcdr (XCAR (tail
));
1347 p
= XPROCESS (proc
);
1350 if (!NILP (query_only
) && p
->kill_without_query
)
1353 Finsert (1, &p
->name
);
1354 Findent_to (i_status
, minspace
);
1356 if (p
->raw_status_new
)
1359 if (CONSP (p
->status
))
1360 symbol
= XCAR (p
->status
);
1362 if (EQ (symbol
, Qsignal
))
1365 tem
= Fcar (Fcdr (p
->status
));
1366 Fprinc (symbol
, Qnil
);
1368 else if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
1370 if (EQ (symbol
, Qexit
))
1371 write_string ("closed", -1);
1372 else if (EQ (p
->command
, Qt
))
1373 write_string ("stopped", -1);
1374 else if (EQ (symbol
, Qrun
))
1375 write_string ("open", -1);
1377 Fprinc (symbol
, Qnil
);
1379 else if (SERIALCONN1_P (p
))
1381 write_string ("running", -1);
1384 Fprinc (symbol
, Qnil
);
1386 if (EQ (symbol
, Qexit
))
1389 tem
= Fcar (Fcdr (p
->status
));
1392 sprintf (tembuf
, " %d", (int) XFASTINT (tem
));
1393 write_string (tembuf
, -1);
1397 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
) || EQ (symbol
, Qclosed
))
1400 Findent_to (i_buffer
, minspace
);
1401 if (NILP (p
->buffer
))
1402 insert_string ("(none)");
1403 else if (NILP (XBUFFER (p
->buffer
)->name
))
1404 insert_string ("(Killed)");
1406 Finsert (1, &XBUFFER (p
->buffer
)->name
);
1410 Findent_to (i_tty
, minspace
);
1411 if (STRINGP (p
->tty_name
))
1412 Finsert (1, &p
->tty_name
);
1415 Findent_to (i_command
, minspace
);
1417 if (EQ (p
->status
, Qlisten
))
1419 Lisp_Object port
= Fplist_get (p
->childp
, QCservice
);
1420 if (INTEGERP (port
))
1421 port
= Fnumber_to_string (port
);
1423 port
= Fformat_network_address (Fplist_get (p
->childp
, QClocal
), Qnil
);
1424 sprintf (tembuf
, "(network %s server on %s)\n",
1425 (DATAGRAM_CHAN_P (p
->infd
) ? "datagram" : "stream"),
1426 (STRINGP (port
) ? (char *)SDATA (port
) : "?"));
1427 insert_string (tembuf
);
1429 else if (NETCONN1_P (p
))
1431 /* For a local socket, there is no host name,
1432 so display service instead. */
1433 Lisp_Object host
= Fplist_get (p
->childp
, QChost
);
1434 if (!STRINGP (host
))
1436 host
= Fplist_get (p
->childp
, QCservice
);
1437 if (INTEGERP (host
))
1438 host
= Fnumber_to_string (host
);
1441 host
= Fformat_network_address (Fplist_get (p
->childp
, QCremote
), Qnil
);
1442 sprintf (tembuf
, "(network %s connection to %s)\n",
1443 (DATAGRAM_CHAN_P (p
->infd
) ? "datagram" : "stream"),
1444 (STRINGP (host
) ? (char *)SDATA (host
) : "?"));
1445 insert_string (tembuf
);
1447 else if (SERIALCONN1_P (p
))
1449 Lisp_Object port
= Fplist_get (p
->childp
, QCport
);
1450 Lisp_Object speed
= Fplist_get (p
->childp
, QCspeed
);
1451 insert_string ("(serial port ");
1453 insert_string (SDATA (port
));
1455 insert_string ("?");
1456 if (INTEGERP (speed
))
1458 sprintf (tembuf
, " at %ld b/s", (long) XINT (speed
));
1459 insert_string (tembuf
);
1461 insert_string (")\n");
1475 insert_string (" ");
1477 insert_string ("\n");
1482 status_notify (NULL
);
1483 redisplay_preserve_echo_area (13);
1488 DEFUN ("list-processes", Flist_processes
, Slist_processes
, 0, 1, "P",
1489 doc
: /* Display a list of all processes.
1490 If optional argument QUERY-ONLY is non-nil, only processes with
1491 the query-on-exit flag set will be listed.
1492 Any process listed as exited or signaled is actually eliminated
1493 after the listing is made. */)
1494 (Lisp_Object query_only
)
1496 internal_with_output_to_temp_buffer ("*Process List*",
1497 list_processes_1
, query_only
);
1501 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
1502 doc
: /* Return a list of all processes. */)
1505 return Fmapcar (Qcdr
, Vprocess_alist
);
1508 /* Starting asynchronous inferior processes. */
1510 static Lisp_Object
start_process_unwind (Lisp_Object proc
);
1512 DEFUN ("start-process", Fstart_process
, Sstart_process
, 3, MANY
, 0,
1513 doc
: /* Start a program in a subprocess. Return the process object for it.
1514 NAME is name for process. It is modified if necessary to make it unique.
1515 BUFFER is the buffer (or buffer name) to associate with the process.
1517 Process output (both standard output and standard error streams) goes
1518 at end of BUFFER, unless you specify an output stream or filter
1519 function to handle the output. BUFFER may also be nil, meaning that
1520 this process is not associated with any buffer.
1522 PROGRAM is the program file name. It is searched for in PATH. If
1523 nil, just associate a pty with the buffer. Remaining arguments are
1524 strings to give program as arguments.
1526 If you want to separate standard output from standard error, invoke
1527 the command through a shell and redirect one of them using the shell
1530 usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1531 (int nargs
, register Lisp_Object
*args
)
1533 Lisp_Object buffer
, name
, program
, proc
, current_dir
, tem
;
1534 register unsigned char **new_argv
;
1536 int count
= SPECPDL_INDEX ();
1540 buffer
= Fget_buffer_create (buffer
);
1542 /* Make sure that the child will be able to chdir to the current
1543 buffer's current directory, or its unhandled equivalent. We
1544 can't just have the child check for an error when it does the
1545 chdir, since it's in a vfork.
1547 We have to GCPRO around this because Fexpand_file_name and
1548 Funhandled_file_name_directory might call a file name handling
1549 function. The argument list is protected by the caller, so all
1550 we really have to worry about is buffer. */
1552 struct gcpro gcpro1
, gcpro2
;
1554 current_dir
= current_buffer
->directory
;
1556 GCPRO2 (buffer
, current_dir
);
1558 current_dir
= Funhandled_file_name_directory (current_dir
);
1559 if (NILP (current_dir
))
1560 /* If the file name handler says that current_dir is unreachable, use
1561 a sensible default. */
1562 current_dir
= build_string ("~/");
1563 current_dir
= expand_and_dir_to_file (current_dir
, Qnil
);
1564 if (NILP (Ffile_accessible_directory_p (current_dir
)))
1565 report_file_error ("Setting current directory",
1566 Fcons (current_buffer
->directory
, Qnil
));
1572 CHECK_STRING (name
);
1576 if (!NILP (program
))
1577 CHECK_STRING (program
);
1579 proc
= make_process (name
);
1580 /* If an error occurs and we can't start the process, we want to
1581 remove it from the process list. This means that each error
1582 check in create_process doesn't need to call remove_process
1583 itself; it's all taken care of here. */
1584 record_unwind_protect (start_process_unwind
, proc
);
1586 XPROCESS (proc
)->childp
= Qt
;
1587 XPROCESS (proc
)->plist
= Qnil
;
1588 XPROCESS (proc
)->type
= Qreal
;
1589 XPROCESS (proc
)->buffer
= buffer
;
1590 XPROCESS (proc
)->sentinel
= Qnil
;
1591 XPROCESS (proc
)->filter
= Qnil
;
1592 XPROCESS (proc
)->command
= Flist (nargs
- 2, args
+ 2);
1594 #ifdef ADAPTIVE_READ_BUFFERING
1595 XPROCESS (proc
)->adaptive_read_buffering
1596 = (NILP (Vprocess_adaptive_read_buffering
) ? 0
1597 : EQ (Vprocess_adaptive_read_buffering
, Qt
) ? 1 : 2);
1600 /* Make the process marker point into the process buffer (if any). */
1601 if (BUFFERP (buffer
))
1602 set_marker_both (XPROCESS (proc
)->mark
, buffer
,
1603 BUF_ZV (XBUFFER (buffer
)),
1604 BUF_ZV_BYTE (XBUFFER (buffer
)));
1607 /* Decide coding systems for communicating with the process. Here
1608 we don't setup the structure coding_system nor pay attention to
1609 unibyte mode. They are done in create_process. */
1611 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1612 Lisp_Object coding_systems
= Qt
;
1613 Lisp_Object val
, *args2
;
1614 struct gcpro gcpro1
, gcpro2
;
1616 val
= Vcoding_system_for_read
;
1619 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
1620 args2
[0] = Qstart_process
;
1621 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1622 GCPRO2 (proc
, current_dir
);
1623 if (!NILP (program
))
1624 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1626 if (CONSP (coding_systems
))
1627 val
= XCAR (coding_systems
);
1628 else if (CONSP (Vdefault_process_coding_system
))
1629 val
= XCAR (Vdefault_process_coding_system
);
1631 XPROCESS (proc
)->decode_coding_system
= val
;
1633 val
= Vcoding_system_for_write
;
1636 if (EQ (coding_systems
, Qt
))
1638 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof args2
);
1639 args2
[0] = Qstart_process
;
1640 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1641 GCPRO2 (proc
, current_dir
);
1642 if (!NILP (program
))
1643 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1646 if (CONSP (coding_systems
))
1647 val
= XCDR (coding_systems
);
1648 else if (CONSP (Vdefault_process_coding_system
))
1649 val
= XCDR (Vdefault_process_coding_system
);
1651 XPROCESS (proc
)->encode_coding_system
= val
;
1655 XPROCESS (proc
)->decoding_buf
= make_uninit_string (0);
1656 XPROCESS (proc
)->decoding_carryover
= 0;
1657 XPROCESS (proc
)->encoding_buf
= make_uninit_string (0);
1659 XPROCESS (proc
)->inherit_coding_system_flag
1660 = !(NILP (buffer
) || !inherit_process_coding_system
);
1662 if (!NILP (program
))
1664 /* If program file name is not absolute, search our path for it.
1665 Put the name we will really use in TEM. */
1666 if (!IS_DIRECTORY_SEP (SREF (program
, 0))
1667 && !(SCHARS (program
) > 1
1668 && IS_DEVICE_SEP (SREF (program
, 1))))
1670 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1673 GCPRO4 (name
, program
, buffer
, current_dir
);
1674 openp (Vexec_path
, program
, Vexec_suffixes
, &tem
, make_number (X_OK
));
1677 report_file_error ("Searching for program", Fcons (program
, Qnil
));
1678 tem
= Fexpand_file_name (tem
, Qnil
);
1682 if (!NILP (Ffile_directory_p (program
)))
1683 error ("Specified program for new process is a directory");
1687 /* If program file name starts with /: for quoting a magic name,
1689 if (SBYTES (tem
) > 2 && SREF (tem
, 0) == '/'
1690 && SREF (tem
, 1) == ':')
1691 tem
= Fsubstring (tem
, make_number (2), Qnil
);
1694 struct gcpro gcpro1
;
1697 /* Encode the file name and put it in NEW_ARGV.
1698 That's where the child will use it to execute the program. */
1699 tem
= Fcons (ENCODE_FILE (tem
), Qnil
);
1701 /* Here we encode arguments by the coding system used for sending
1702 data to the process. We don't support using different coding
1703 systems for encoding arguments and for encoding data sent to the
1706 for (i
= 3; i
< nargs
; i
++)
1708 tem
= Fcons (args
[i
], tem
);
1709 CHECK_STRING (XCAR (tem
));
1710 if (STRING_MULTIBYTE (XCAR (tem
)))
1712 code_convert_string_norecord
1713 (XCAR (tem
), XPROCESS (proc
)->encode_coding_system
, 1));
1719 /* Now that everything is encoded we can collect the strings into
1721 new_argv
= (unsigned char **) alloca ((nargs
- 1) * sizeof (char *));
1722 new_argv
[nargs
- 2] = 0;
1724 for (i
= nargs
- 3; i
>= 0; i
--)
1726 new_argv
[i
] = SDATA (XCAR (tem
));
1730 create_process (proc
, (char **) new_argv
, current_dir
);
1735 return unbind_to (count
, proc
);
1738 /* This function is the unwind_protect form for Fstart_process. If
1739 PROC doesn't have its pid set, then we know someone has signaled
1740 an error and the process wasn't started successfully, so we should
1741 remove it from the process list. */
1743 start_process_unwind (Lisp_Object proc
)
1745 if (!PROCESSP (proc
))
1748 /* Was PROC started successfully? */
1749 if (XPROCESS (proc
)->pid
== -1)
1750 remove_process (proc
);
1756 create_process_1 (struct atimer
*timer
)
1758 /* Nothing to do. */
1762 #if 0 /* This doesn't work; see the note before sigchld_handler. */
1765 /* Mimic blocking of signals on system V, which doesn't really have it. */
1767 /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1768 int sigchld_deferred
;
1771 create_process_sigchld ()
1773 signal (SIGCHLD
, create_process_sigchld
);
1775 sigchld_deferred
= 1;
1782 create_process (Lisp_Object process
, char **new_argv
, Lisp_Object current_dir
)
1784 int inchannel
, outchannel
;
1787 #if !defined (WINDOWSNT) && defined (FD_CLOEXEC)
1788 int wait_child_setup
[2];
1792 struct sigaction sigint_action
;
1793 struct sigaction sigquit_action
;
1795 struct sigaction sighup_action
;
1797 /* Use volatile to protect variables from being clobbered by longjmp. */
1798 volatile int forkin
, forkout
;
1799 volatile int pty_flag
= 0;
1801 extern char **environ
;
1804 inchannel
= outchannel
= -1;
1807 if (!NILP (Vprocess_connection_type
))
1808 outchannel
= inchannel
= allocate_pty ();
1812 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1813 /* On most USG systems it does not work to open the pty's tty here,
1814 then close it and reopen it in the child. */
1816 /* Don't let this terminal become our controlling terminal
1817 (in case we don't have one). */
1818 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1820 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
, 0);
1823 report_file_error ("Opening pty", Qnil
);
1825 forkin
= forkout
= -1;
1826 #endif /* not USG, or USG_SUBTTY_WORKS */
1830 #endif /* HAVE_PTYS */
1835 report_file_error ("Creating pipe", Qnil
);
1841 emacs_close (inchannel
);
1842 emacs_close (forkout
);
1843 report_file_error ("Creating pipe", Qnil
);
1849 #if !defined (WINDOWSNT) && defined (FD_CLOEXEC)
1853 tem
= pipe (wait_child_setup
);
1855 report_file_error ("Creating pipe", Qnil
);
1856 tem
= fcntl (wait_child_setup
[1], F_GETFD
, 0);
1858 tem
= fcntl (wait_child_setup
[1], F_SETFD
, tem
| FD_CLOEXEC
);
1861 emacs_close (wait_child_setup
[0]);
1862 emacs_close (wait_child_setup
[1]);
1863 report_file_error ("Setting file descriptor flags", Qnil
);
1869 /* Replaced by close_process_descs */
1870 set_exclusive_use (inchannel
);
1871 set_exclusive_use (outchannel
);
1875 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1876 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
1879 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1880 fcntl (outchannel
, F_SETFL
, O_NDELAY
);
1884 /* Record this as an active process, with its channels.
1885 As a result, child_setup will close Emacs's side of the pipes. */
1886 chan_process
[inchannel
] = process
;
1887 XPROCESS (process
)->infd
= inchannel
;
1888 XPROCESS (process
)->outfd
= outchannel
;
1890 /* Previously we recorded the tty descriptor used in the subprocess.
1891 It was only used for getting the foreground tty process, so now
1892 we just reopen the device (see emacs_get_tty_pgrp) as this is
1893 more portable (see USG_SUBTTY_WORKS above). */
1895 XPROCESS (process
)->pty_flag
= pty_flag
;
1896 XPROCESS (process
)->status
= Qrun
;
1897 setup_process_coding_systems (process
);
1899 /* Delay interrupts until we have a chance to store
1900 the new fork's pid in its process structure */
1901 sigemptyset (&blocked
);
1903 sigaddset (&blocked
, SIGCHLD
);
1905 #ifdef HAVE_WORKING_VFORK
1906 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
1907 this sets the parent's signal handlers as well as the child's.
1908 So delay all interrupts whose handlers the child might munge,
1909 and record the current handlers so they can be restored later. */
1910 sigaddset (&blocked
, SIGINT
); sigaction (SIGINT
, 0, &sigint_action
);
1911 sigaddset (&blocked
, SIGQUIT
); sigaction (SIGQUIT
, 0, &sigquit_action
);
1913 sigaddset (&blocked
, SIGHUP
); sigaction (SIGHUP
, 0, &sighup_action
);
1915 #endif /* HAVE_WORKING_VFORK */
1916 sigprocmask (SIG_BLOCK
, &blocked
, &procmask
);
1918 FD_SET (inchannel
, &input_wait_mask
);
1919 FD_SET (inchannel
, &non_keyboard_wait_mask
);
1920 if (inchannel
> max_process_desc
)
1921 max_process_desc
= inchannel
;
1923 /* Until we store the proper pid, enable sigchld_handler
1924 to recognize an unknown pid as standing for this process.
1925 It is very important not to let this `marker' value stay
1926 in the table after this function has returned; if it does
1927 it might cause call-process to hang and subsequent asynchronous
1928 processes to get their return values scrambled. */
1929 XPROCESS (process
)->pid
= -1;
1934 /* child_setup must clobber environ on systems with true vfork.
1935 Protect it from permanent change. */
1936 char **save_environ
= environ
;
1938 current_dir
= ENCODE_FILE (current_dir
);
1943 #endif /* not WINDOWSNT */
1945 int xforkin
= forkin
;
1946 int xforkout
= forkout
;
1948 #if 0 /* This was probably a mistake--it duplicates code later on,
1949 but fails to handle all the cases. */
1950 /* Make sure SIGCHLD is not blocked in the child. */
1951 sigsetmask (SIGEMPTYMASK
);
1954 /* Make the pty be the controlling terminal of the process. */
1956 /* First, disconnect its current controlling terminal. */
1958 /* We tried doing setsid only if pty_flag, but it caused
1959 process_set_signal to fail on SGI when using a pipe. */
1961 /* Make the pty's terminal the controlling terminal. */
1962 if (pty_flag
&& xforkin
>= 0)
1965 /* We ignore the return value
1966 because faith@cs.unc.edu says that is necessary on Linux. */
1967 ioctl (xforkin
, TIOCSCTTY
, 0);
1970 #else /* not HAVE_SETSID */
1972 /* It's very important to call setpgrp here and no time
1973 afterwards. Otherwise, we lose our controlling tty which
1974 is set when we open the pty. */
1977 #endif /* not HAVE_SETSID */
1978 #if defined (HAVE_TERMIOS) && defined (LDISC1)
1979 if (pty_flag
&& xforkin
>= 0)
1982 tcgetattr (xforkin
, &t
);
1984 if (tcsetattr (xforkin
, TCSANOW
, &t
) < 0)
1985 emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
1988 #if defined (NTTYDISC) && defined (TIOCSETD)
1989 if (pty_flag
&& xforkin
>= 0)
1991 /* Use new line discipline. */
1992 int ldisc
= NTTYDISC
;
1993 ioctl (xforkin
, TIOCSETD
, &ldisc
);
1998 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
1999 can do TIOCSPGRP only to the process's controlling tty. */
2002 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
2003 I can't test it since I don't have 4.3. */
2004 int j
= emacs_open ("/dev/tty", O_RDWR
, 0);
2007 ioctl (j
, TIOCNOTTY
, 0);
2011 /* In order to get a controlling terminal on some versions
2012 of BSD, it is necessary to put the process in pgrp 0
2013 before it opens the terminal. */
2021 #endif /* TIOCNOTTY */
2023 #if !defined (DONT_REOPEN_PTY)
2024 /*** There is a suggestion that this ought to be a
2025 conditional on TIOCSPGRP,
2026 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
2027 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
2028 that system does seem to need this code, even though
2029 both HAVE_SETSID and TIOCSCTTY are defined. */
2030 /* Now close the pty (if we had it open) and reopen it.
2031 This makes the pty the controlling terminal of the subprocess. */
2035 /* I wonder if emacs_close (emacs_open (pty_name, ...))
2038 emacs_close (xforkin
);
2039 xforkout
= xforkin
= emacs_open (pty_name
, O_RDWR
, 0);
2043 emacs_write (1, "Couldn't open the pty terminal ", 31);
2044 emacs_write (1, pty_name
, strlen (pty_name
));
2045 emacs_write (1, "\n", 1);
2050 #endif /* not DONT_REOPEN_PTY */
2052 #ifdef SETUP_SLAVE_PTY
2057 #endif /* SETUP_SLAVE_PTY */
2059 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
2060 Now reenable it in the child, so it will die when we want it to. */
2062 signal (SIGHUP
, SIG_DFL
);
2064 #endif /* HAVE_PTYS */
2066 signal (SIGINT
, SIG_DFL
);
2067 signal (SIGQUIT
, SIG_DFL
);
2069 /* Stop blocking signals in the child. */
2070 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2073 child_setup_tty (xforkout
);
2075 pid
= child_setup (xforkin
, xforkout
, xforkout
,
2076 new_argv
, 1, current_dir
);
2077 #else /* not WINDOWSNT */
2079 emacs_close (wait_child_setup
[0]);
2081 child_setup (xforkin
, xforkout
, xforkout
,
2082 new_argv
, 1, current_dir
);
2083 #endif /* not WINDOWSNT */
2085 environ
= save_environ
;
2090 /* This runs in the Emacs process. */
2094 emacs_close (forkin
);
2095 if (forkin
!= forkout
&& forkout
>= 0)
2096 emacs_close (forkout
);
2100 /* vfork succeeded. */
2101 XPROCESS (process
)->pid
= pid
;
2104 register_child (pid
, inchannel
);
2105 #endif /* WINDOWSNT */
2107 /* If the subfork execv fails, and it exits,
2108 this close hangs. I don't know why.
2109 So have an interrupt jar it loose. */
2111 struct atimer
*timer
;
2115 EMACS_SET_SECS_USECS (offset
, 1, 0);
2116 timer
= start_atimer (ATIMER_RELATIVE
, offset
, create_process_1
, 0);
2119 emacs_close (forkin
);
2121 cancel_atimer (timer
);
2125 if (forkin
!= forkout
&& forkout
>= 0)
2126 emacs_close (forkout
);
2130 XPROCESS (process
)->tty_name
= build_string (pty_name
);
2133 XPROCESS (process
)->tty_name
= Qnil
;
2135 #if !defined (WINDOWSNT) && defined (FD_CLOEXEC)
2136 /* Wait for child_setup to complete in case that vfork is
2137 actually defined as fork. The descriptor wait_child_setup[1]
2138 of a pipe is closed at the child side either by close-on-exec
2139 on successful execvp or the _exit call in child_setup. */
2143 emacs_close (wait_child_setup
[1]);
2144 emacs_read (wait_child_setup
[0], &dummy
, 1);
2145 emacs_close (wait_child_setup
[0]);
2150 /* Restore the signal state whether vfork succeeded or not.
2151 (We will signal an error, below, if it failed.) */
2152 #ifdef HAVE_WORKING_VFORK
2153 /* Restore the parent's signal handlers. */
2154 sigaction (SIGINT
, &sigint_action
, 0);
2155 sigaction (SIGQUIT
, &sigquit_action
, 0);
2157 sigaction (SIGHUP
, &sighup_action
, 0);
2159 #endif /* HAVE_WORKING_VFORK */
2160 /* Stop blocking signals in the parent. */
2161 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2163 /* Now generate the error if vfork failed. */
2165 report_file_error ("Doing vfork", Qnil
);
2169 create_pty (Lisp_Object process
)
2171 int inchannel
, outchannel
;
2173 /* Use volatile to protect variables from being clobbered by longjmp. */
2174 volatile int forkin
, forkout
;
2175 volatile int pty_flag
= 0;
2177 inchannel
= outchannel
= -1;
2180 if (!NILP (Vprocess_connection_type
))
2181 outchannel
= inchannel
= allocate_pty ();
2185 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
2186 /* On most USG systems it does not work to open the pty's tty here,
2187 then close it and reopen it in the child. */
2189 /* Don't let this terminal become our controlling terminal
2190 (in case we don't have one). */
2191 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
2193 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
, 0);
2196 report_file_error ("Opening pty", Qnil
);
2197 #if defined (DONT_REOPEN_PTY)
2198 /* In the case that vfork is defined as fork, the parent process
2199 (Emacs) may send some data before the child process completes
2200 tty options setup. So we setup tty before forking. */
2201 child_setup_tty (forkout
);
2202 #endif /* DONT_REOPEN_PTY */
2204 forkin
= forkout
= -1;
2205 #endif /* not USG, or USG_SUBTTY_WORKS */
2208 #endif /* HAVE_PTYS */
2211 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
2212 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
2215 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
2216 fcntl (outchannel
, F_SETFL
, O_NDELAY
);
2220 /* Record this as an active process, with its channels.
2221 As a result, child_setup will close Emacs's side of the pipes. */
2222 chan_process
[inchannel
] = process
;
2223 XPROCESS (process
)->infd
= inchannel
;
2224 XPROCESS (process
)->outfd
= outchannel
;
2226 /* Previously we recorded the tty descriptor used in the subprocess.
2227 It was only used for getting the foreground tty process, so now
2228 we just reopen the device (see emacs_get_tty_pgrp) as this is
2229 more portable (see USG_SUBTTY_WORKS above). */
2231 XPROCESS (process
)->pty_flag
= pty_flag
;
2232 XPROCESS (process
)->status
= Qrun
;
2233 setup_process_coding_systems (process
);
2235 FD_SET (inchannel
, &input_wait_mask
);
2236 FD_SET (inchannel
, &non_keyboard_wait_mask
);
2237 if (inchannel
> max_process_desc
)
2238 max_process_desc
= inchannel
;
2240 XPROCESS (process
)->pid
= -2;
2243 XPROCESS (process
)->tty_name
= build_string (pty_name
);
2246 XPROCESS (process
)->tty_name
= Qnil
;
2252 /* Convert an internal struct sockaddr to a lisp object (vector or string).
2253 The address family of sa is not included in the result. */
2256 conv_sockaddr_to_lisp (struct sockaddr
*sa
, int len
)
2258 Lisp_Object address
;
2261 register struct Lisp_Vector
*p
;
2263 /* Workaround for a bug in getsockname on BSD: Names bound to
2264 sockets in the UNIX domain are inaccessible; getsockname returns
2265 a zero length name. */
2266 if (len
< offsetof (struct sockaddr
, sa_family
) + sizeof (sa
->sa_family
))
2267 return empty_unibyte_string
;
2269 switch (sa
->sa_family
)
2273 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2274 len
= sizeof (sin
->sin_addr
) + 1;
2275 address
= Fmake_vector (make_number (len
), Qnil
);
2276 p
= XVECTOR (address
);
2277 p
->contents
[--len
] = make_number (ntohs (sin
->sin_port
));
2278 cp
= (unsigned char *) &sin
->sin_addr
;
2284 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2285 uint16_t *ip6
= (uint16_t *) &sin6
->sin6_addr
;
2286 len
= sizeof (sin6
->sin6_addr
)/2 + 1;
2287 address
= Fmake_vector (make_number (len
), Qnil
);
2288 p
= XVECTOR (address
);
2289 p
->contents
[--len
] = make_number (ntohs (sin6
->sin6_port
));
2290 for (i
= 0; i
< len
; i
++)
2291 p
->contents
[i
] = make_number (ntohs (ip6
[i
]));
2295 #ifdef HAVE_LOCAL_SOCKETS
2298 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2299 for (i
= 0; i
< sizeof (sockun
->sun_path
); i
++)
2300 if (sockun
->sun_path
[i
] == 0)
2302 return make_unibyte_string (sockun
->sun_path
, i
);
2306 len
-= offsetof (struct sockaddr
, sa_family
) + sizeof (sa
->sa_family
);
2307 address
= Fcons (make_number (sa
->sa_family
),
2308 Fmake_vector (make_number (len
), Qnil
));
2309 p
= XVECTOR (XCDR (address
));
2310 cp
= (unsigned char *) &sa
->sa_family
+ sizeof (sa
->sa_family
);
2316 p
->contents
[i
++] = make_number (*cp
++);
2322 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2325 get_lisp_to_sockaddr_size (Lisp_Object address
, int *familyp
)
2327 register struct Lisp_Vector
*p
;
2329 if (VECTORP (address
))
2331 p
= XVECTOR (address
);
2335 return sizeof (struct sockaddr_in
);
2338 else if (p
->size
== 9)
2340 *familyp
= AF_INET6
;
2341 return sizeof (struct sockaddr_in6
);
2345 #ifdef HAVE_LOCAL_SOCKETS
2346 else if (STRINGP (address
))
2348 *familyp
= AF_LOCAL
;
2349 return sizeof (struct sockaddr_un
);
2352 else if (CONSP (address
) && INTEGERP (XCAR (address
)) && VECTORP (XCDR (address
)))
2354 struct sockaddr
*sa
;
2355 *familyp
= XINT (XCAR (address
));
2356 p
= XVECTOR (XCDR (address
));
2357 return p
->size
+ sizeof (sa
->sa_family
);
2362 /* Convert an address object (vector or string) to an internal sockaddr.
2364 The address format has been basically validated by
2365 get_lisp_to_sockaddr_size, but this does not mean FAMILY is valid;
2366 it could have come from user data. So if FAMILY is not valid,
2367 we return after zeroing *SA. */
2370 conv_lisp_to_sockaddr (int family
, Lisp_Object address
, struct sockaddr
*sa
, int len
)
2372 register struct Lisp_Vector
*p
;
2373 register unsigned char *cp
= NULL
;
2376 memset (sa
, 0, len
);
2378 if (VECTORP (address
))
2380 p
= XVECTOR (address
);
2381 if (family
== AF_INET
)
2383 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2384 len
= sizeof (sin
->sin_addr
) + 1;
2385 i
= XINT (p
->contents
[--len
]);
2386 sin
->sin_port
= htons (i
);
2387 cp
= (unsigned char *)&sin
->sin_addr
;
2388 sa
->sa_family
= family
;
2391 else if (family
== AF_INET6
)
2393 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2394 uint16_t *ip6
= (uint16_t *)&sin6
->sin6_addr
;
2395 len
= sizeof (sin6
->sin6_addr
) + 1;
2396 i
= XINT (p
->contents
[--len
]);
2397 sin6
->sin6_port
= htons (i
);
2398 for (i
= 0; i
< len
; i
++)
2399 if (INTEGERP (p
->contents
[i
]))
2401 int j
= XFASTINT (p
->contents
[i
]) & 0xffff;
2404 sa
->sa_family
= family
;
2411 else if (STRINGP (address
))
2413 #ifdef HAVE_LOCAL_SOCKETS
2414 if (family
== AF_LOCAL
)
2416 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2417 cp
= SDATA (address
);
2418 for (i
= 0; i
< sizeof (sockun
->sun_path
) && *cp
; i
++)
2419 sockun
->sun_path
[i
] = *cp
++;
2420 sa
->sa_family
= family
;
2427 p
= XVECTOR (XCDR (address
));
2428 cp
= (unsigned char *)sa
+ sizeof (sa
->sa_family
);
2431 for (i
= 0; i
< len
; i
++)
2432 if (INTEGERP (p
->contents
[i
]))
2433 *cp
++ = XFASTINT (p
->contents
[i
]) & 0xff;
2436 #ifdef DATAGRAM_SOCKETS
2437 DEFUN ("process-datagram-address", Fprocess_datagram_address
, Sprocess_datagram_address
,
2439 doc
: /* Get the current datagram address associated with PROCESS. */)
2440 (Lisp_Object process
)
2444 CHECK_PROCESS (process
);
2446 if (!DATAGRAM_CONN_P (process
))
2449 channel
= XPROCESS (process
)->infd
;
2450 return conv_sockaddr_to_lisp (datagram_address
[channel
].sa
,
2451 datagram_address
[channel
].len
);
2454 DEFUN ("set-process-datagram-address", Fset_process_datagram_address
, Sset_process_datagram_address
,
2456 doc
: /* Set the datagram address for PROCESS to ADDRESS.
2457 Returns nil upon error setting address, ADDRESS otherwise. */)
2458 (Lisp_Object process
, Lisp_Object address
)
2463 CHECK_PROCESS (process
);
2465 if (!DATAGRAM_CONN_P (process
))
2468 channel
= XPROCESS (process
)->infd
;
2470 len
= get_lisp_to_sockaddr_size (address
, &family
);
2471 if (datagram_address
[channel
].len
!= len
)
2473 conv_lisp_to_sockaddr (family
, address
, datagram_address
[channel
].sa
, len
);
2479 static const struct socket_options
{
2480 /* The name of this option. Should be lowercase version of option
2481 name without SO_ prefix. */
2483 /* Option level SOL_... */
2485 /* Option number SO_... */
2487 enum { SOPT_UNKNOWN
, SOPT_BOOL
, SOPT_INT
, SOPT_IFNAME
, SOPT_LINGER
} opttype
;
2488 enum { OPIX_NONE
=0, OPIX_MISC
=1, OPIX_REUSEADDR
=2 } optbit
;
2489 } socket_options
[] =
2491 #ifdef SO_BINDTODEVICE
2492 { ":bindtodevice", SOL_SOCKET
, SO_BINDTODEVICE
, SOPT_IFNAME
, OPIX_MISC
},
2495 { ":broadcast", SOL_SOCKET
, SO_BROADCAST
, SOPT_BOOL
, OPIX_MISC
},
2498 { ":dontroute", SOL_SOCKET
, SO_DONTROUTE
, SOPT_BOOL
, OPIX_MISC
},
2501 { ":keepalive", SOL_SOCKET
, SO_KEEPALIVE
, SOPT_BOOL
, OPIX_MISC
},
2504 { ":linger", SOL_SOCKET
, SO_LINGER
, SOPT_LINGER
, OPIX_MISC
},
2507 { ":oobinline", SOL_SOCKET
, SO_OOBINLINE
, SOPT_BOOL
, OPIX_MISC
},
2510 { ":priority", SOL_SOCKET
, SO_PRIORITY
, SOPT_INT
, OPIX_MISC
},
2513 { ":reuseaddr", SOL_SOCKET
, SO_REUSEADDR
, SOPT_BOOL
, OPIX_REUSEADDR
},
2515 { 0, 0, 0, SOPT_UNKNOWN
, OPIX_NONE
}
2518 /* Set option OPT to value VAL on socket S.
2520 Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2521 Signals an error if setting a known option fails.
2525 set_socket_option (int s
, Lisp_Object opt
, Lisp_Object val
)
2528 const struct socket_options
*sopt
;
2533 name
= (char *) SDATA (SYMBOL_NAME (opt
));
2534 for (sopt
= socket_options
; sopt
->name
; sopt
++)
2535 if (strcmp (name
, sopt
->name
) == 0)
2538 switch (sopt
->opttype
)
2543 optval
= NILP (val
) ? 0 : 1;
2544 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2545 &optval
, sizeof (optval
));
2553 optval
= XINT (val
);
2555 error ("Bad option value for %s", name
);
2556 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2557 &optval
, sizeof (optval
));
2561 #ifdef SO_BINDTODEVICE
2564 char devname
[IFNAMSIZ
+1];
2566 /* This is broken, at least in the Linux 2.4 kernel.
2567 To unbind, the arg must be a zero integer, not the empty string.
2568 This should work on all systems. KFS. 2003-09-23. */
2569 memset (devname
, 0, sizeof devname
);
2572 char *arg
= (char *) SDATA (val
);
2573 int len
= min (strlen (arg
), IFNAMSIZ
);
2574 memcpy (devname
, arg
, len
);
2576 else if (!NILP (val
))
2577 error ("Bad option value for %s", name
);
2578 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2587 struct linger linger
;
2590 linger
.l_linger
= 0;
2592 linger
.l_linger
= XINT (val
);
2594 linger
.l_onoff
= NILP (val
) ? 0 : 1;
2595 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2596 &linger
, sizeof (linger
));
2606 report_file_error ("Cannot set network option",
2607 Fcons (opt
, Fcons (val
, Qnil
)));
2608 return (1 << sopt
->optbit
);
2612 DEFUN ("set-network-process-option",
2613 Fset_network_process_option
, Sset_network_process_option
,
2615 doc
: /* For network process PROCESS set option OPTION to value VALUE.
2616 See `make-network-process' for a list of options and values.
2617 If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2618 OPTION is not a supported option, return nil instead; otherwise return t. */)
2619 (Lisp_Object process
, Lisp_Object option
, Lisp_Object value
, Lisp_Object no_error
)
2622 struct Lisp_Process
*p
;
2624 CHECK_PROCESS (process
);
2625 p
= XPROCESS (process
);
2626 if (!NETCONN1_P (p
))
2627 error ("Process is not a network process");
2631 error ("Process is not running");
2633 if (set_socket_option (s
, option
, value
))
2635 p
->childp
= Fplist_put (p
->childp
, option
, value
);
2639 if (NILP (no_error
))
2640 error ("Unknown or unsupported option");
2647 DEFUN ("serial-process-configure",
2648 Fserial_process_configure
,
2649 Sserial_process_configure
,
2651 doc
: /* Configure speed, bytesize, etc. of a serial process.
2653 Arguments are specified as keyword/argument pairs. Attributes that
2654 are not given are re-initialized from the process's current
2655 configuration (available via the function `process-contact') or set to
2656 reasonable default values. The following arguments are defined:
2662 -- Any of these arguments can be given to identify the process that is
2663 to be configured. If none of these arguments is given, the current
2664 buffer's process is used.
2666 :speed SPEED -- SPEED is the speed of the serial port in bits per
2667 second, also called baud rate. Any value can be given for SPEED, but
2668 most serial ports work only at a few defined values between 1200 and
2669 115200, with 9600 being the most common value. If SPEED is nil, the
2670 serial port is not configured any further, i.e., all other arguments
2671 are ignored. This may be useful for special serial ports such as
2672 Bluetooth-to-serial converters which can only be configured through AT
2673 commands. A value of nil for SPEED can be used only when passed
2674 through `make-serial-process' or `serial-term'.
2676 :bytesize BYTESIZE -- BYTESIZE is the number of bits per byte, which
2677 can be 7 or 8. If BYTESIZE is not given or nil, a value of 8 is used.
2679 :parity PARITY -- PARITY can be nil (don't use parity), the symbol
2680 `odd' (use odd parity), or the symbol `even' (use even parity). If
2681 PARITY is not given, no parity is used.
2683 :stopbits STOPBITS -- STOPBITS is the number of stopbits used to
2684 terminate a byte transmission. STOPBITS can be 1 or 2. If STOPBITS
2685 is not given or nil, 1 stopbit is used.
2687 :flowcontrol FLOWCONTROL -- FLOWCONTROL determines the type of
2688 flowcontrol to be used, which is either nil (don't use flowcontrol),
2689 the symbol `hw' (use RTS/CTS hardware flowcontrol), or the symbol `sw'
2690 \(use XON/XOFF software flowcontrol). If FLOWCONTROL is not given, no
2691 flowcontrol is used.
2693 `serial-process-configure' is called by `make-serial-process' for the
2694 initial configuration of the serial port.
2698 \(serial-process-configure :process "/dev/ttyS0" :speed 1200)
2700 \(serial-process-configure
2701 :buffer "COM1" :stopbits 1 :parity 'odd :flowcontrol 'hw)
2703 \(serial-process-configure :port "\\\\.\\COM13" :bytesize 7)
2705 usage: (serial-process-configure &rest ARGS) */)
2706 (int nargs
, Lisp_Object
*args
)
2708 struct Lisp_Process
*p
;
2709 Lisp_Object contact
= Qnil
;
2710 Lisp_Object proc
= Qnil
;
2711 struct gcpro gcpro1
;
2713 contact
= Flist (nargs
, args
);
2716 proc
= Fplist_get (contact
, QCprocess
);
2718 proc
= Fplist_get (contact
, QCname
);
2720 proc
= Fplist_get (contact
, QCbuffer
);
2722 proc
= Fplist_get (contact
, QCport
);
2723 proc
= get_process (proc
);
2724 p
= XPROCESS (proc
);
2725 if (!EQ (p
->type
, Qserial
))
2726 error ("Not a serial process");
2728 if (NILP (Fplist_get (p
->childp
, QCspeed
)))
2734 serial_configure (p
, contact
);
2740 /* Used by make-serial-process to recover from errors. */
2741 Lisp_Object
make_serial_process_unwind (Lisp_Object proc
)
2743 if (!PROCESSP (proc
))
2745 remove_process (proc
);
2749 DEFUN ("make-serial-process", Fmake_serial_process
, Smake_serial_process
,
2751 doc
: /* Create and return a serial port process.
2753 In Emacs, serial port connections are represented by process objects,
2754 so input and output work as for subprocesses, and `delete-process'
2755 closes a serial port connection. However, a serial process has no
2756 process id, it cannot be signaled, and the status codes are different
2757 from normal processes.
2759 `make-serial-process' creates a process and a buffer, on which you
2760 probably want to use `process-send-string'. Try \\[serial-term] for
2761 an interactive terminal. See below for examples.
2763 Arguments are specified as keyword/argument pairs. The following
2764 arguments are defined:
2766 :port PORT -- (mandatory) PORT is the path or name of the serial port.
2767 For example, this could be "/dev/ttyS0" on Unix. On Windows, this
2768 could be "COM1", or "\\\\.\\COM10" for ports higher than COM9 (double
2769 the backslashes in strings).
2771 :speed SPEED -- (mandatory) is handled by `serial-process-configure',
2772 which is called by `make-serial-process'.
2774 :name NAME -- NAME is the name of the process. If NAME is not given,
2775 the value of PORT is used.
2777 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2778 with the process. Process output goes at the end of that buffer,
2779 unless you specify an output stream or filter function to handle the
2780 output. If BUFFER is not given, the value of NAME is used.
2782 :coding CODING -- If CODING is a symbol, it specifies the coding
2783 system used for both reading and writing for this process. If CODING
2784 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2785 ENCODING is used for writing.
2787 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
2788 the process is running. If BOOL is not given, query before exiting.
2790 :stop BOOL -- Start process in the `stopped' state if BOOL is non-nil.
2791 In the stopped state, a serial process does not accept incoming data,
2792 but you can send outgoing data. The stopped state is cleared by
2793 `continue-process' and set by `stop-process'.
2795 :filter FILTER -- Install FILTER as the process filter.
2797 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2799 :plist PLIST -- Install PLIST as the initial plist of the process.
2806 -- These arguments are handled by `serial-process-configure', which is
2807 called by `make-serial-process'.
2809 The original argument list, possibly modified by later configuration,
2810 is available via the function `process-contact'.
2814 \(make-serial-process :port "/dev/ttyS0" :speed 9600)
2816 \(make-serial-process :port "COM1" :speed 115200 :stopbits 2)
2818 \(make-serial-process :port "\\\\.\\COM13" :speed 1200 :bytesize 7 :parity 'odd)
2820 \(make-serial-process :port "/dev/tty.BlueConsole-SPP-1" :speed nil)
2822 usage: (make-serial-process &rest ARGS) */)
2823 (int nargs
, Lisp_Object
*args
)
2826 Lisp_Object proc
, contact
, port
;
2827 struct Lisp_Process
*p
;
2828 struct gcpro gcpro1
;
2829 Lisp_Object name
, buffer
;
2830 Lisp_Object tem
, val
;
2831 int specpdl_count
= -1;
2836 contact
= Flist (nargs
, args
);
2839 port
= Fplist_get (contact
, QCport
);
2841 error ("No port specified");
2842 CHECK_STRING (port
);
2844 if (NILP (Fplist_member (contact
, QCspeed
)))
2845 error (":speed not specified");
2846 if (!NILP (Fplist_get (contact
, QCspeed
)))
2847 CHECK_NUMBER (Fplist_get (contact
, QCspeed
));
2849 name
= Fplist_get (contact
, QCname
);
2852 CHECK_STRING (name
);
2853 proc
= make_process (name
);
2854 specpdl_count
= SPECPDL_INDEX ();
2855 record_unwind_protect (make_serial_process_unwind
, proc
);
2856 p
= XPROCESS (proc
);
2858 fd
= serial_open ((char*) SDATA (port
));
2861 if (fd
> max_process_desc
)
2862 max_process_desc
= fd
;
2863 chan_process
[fd
] = proc
;
2865 buffer
= Fplist_get (contact
, QCbuffer
);
2868 buffer
= Fget_buffer_create (buffer
);
2871 p
->childp
= contact
;
2872 p
->plist
= Fcopy_sequence (Fplist_get (contact
, QCplist
));
2874 p
->sentinel
= Fplist_get (contact
, QCsentinel
);
2875 p
->filter
= Fplist_get (contact
, QCfilter
);
2877 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
2878 p
->kill_without_query
= 1;
2879 if (tem
= Fplist_get (contact
, QCstop
), !NILP (tem
))
2883 if (!EQ (p
->command
, Qt
))
2885 FD_SET (fd
, &input_wait_mask
);
2886 FD_SET (fd
, &non_keyboard_wait_mask
);
2889 if (BUFFERP (buffer
))
2891 set_marker_both (p
->mark
, buffer
,
2892 BUF_ZV (XBUFFER (buffer
)),
2893 BUF_ZV_BYTE (XBUFFER (buffer
)));
2896 tem
= Fplist_member (contact
, QCcoding
);
2897 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
2903 val
= XCAR (XCDR (tem
));
2907 else if (!NILP (Vcoding_system_for_read
))
2908 val
= Vcoding_system_for_read
;
2909 else if ((!NILP (buffer
) && NILP (XBUFFER (buffer
)->enable_multibyte_characters
))
2910 || (NILP (buffer
) && NILP (buffer_defaults
.enable_multibyte_characters
)))
2912 p
->decode_coding_system
= val
;
2917 val
= XCAR (XCDR (tem
));
2921 else if (!NILP (Vcoding_system_for_write
))
2922 val
= Vcoding_system_for_write
;
2923 else if ((!NILP (buffer
) && NILP (XBUFFER (buffer
)->enable_multibyte_characters
))
2924 || (NILP (buffer
) && NILP (buffer_defaults
.enable_multibyte_characters
)))
2926 p
->encode_coding_system
= val
;
2928 setup_process_coding_systems (proc
);
2929 p
->decoding_buf
= make_uninit_string (0);
2930 p
->decoding_carryover
= 0;
2931 p
->encoding_buf
= make_uninit_string (0);
2932 p
->inherit_coding_system_flag
2933 = !(!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
);
2935 Fserial_process_configure (nargs
, args
);
2937 specpdl_ptr
= specpdl
+ specpdl_count
;
2942 #endif /* HAVE_SERIAL */
2944 /* Create a network stream/datagram client/server process. Treated
2945 exactly like a normal process when reading and writing. Primary
2946 differences are in status display and process deletion. A network
2947 connection has no PID; you cannot signal it. All you can do is
2948 stop/continue it and deactivate/close it via delete-process */
2950 DEFUN ("make-network-process", Fmake_network_process
, Smake_network_process
,
2952 doc
: /* Create and return a network server or client process.
2954 In Emacs, network connections are represented by process objects, so
2955 input and output work as for subprocesses and `delete-process' closes
2956 a network connection. However, a network process has no process id,
2957 it cannot be signaled, and the status codes are different from normal
2960 Arguments are specified as keyword/argument pairs. The following
2961 arguments are defined:
2963 :name NAME -- NAME is name for process. It is modified if necessary
2966 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2967 with the process. Process output goes at end of that buffer, unless
2968 you specify an output stream or filter function to handle the output.
2969 BUFFER may be also nil, meaning that this process is not associated
2972 :host HOST -- HOST is name of the host to connect to, or its IP
2973 address. The symbol `local' specifies the local host. If specified
2974 for a server process, it must be a valid name or address for the local
2975 host, and only clients connecting to that address will be accepted.
2977 :service SERVICE -- SERVICE is name of the service desired, or an
2978 integer specifying a port number to connect to. If SERVICE is t,
2979 a random port number is selected for the server. (If Emacs was
2980 compiled with getaddrinfo, a port number can also be specified as a
2981 string, e.g. "80", as well as an integer. This is not portable.)
2983 :type TYPE -- TYPE is the type of connection. The default (nil) is a
2984 stream type connection, `datagram' creates a datagram type connection,
2985 `seqpacket' creates a reliable datagram connection.
2987 :family FAMILY -- FAMILY is the address (and protocol) family for the
2988 service specified by HOST and SERVICE. The default (nil) is to use
2989 whatever address family (IPv4 or IPv6) that is defined for the host
2990 and port number specified by HOST and SERVICE. Other address families
2992 local -- for a local (i.e. UNIX) address specified by SERVICE.
2993 ipv4 -- use IPv4 address family only.
2994 ipv6 -- use IPv6 address family only.
2996 :local ADDRESS -- ADDRESS is the local address used for the connection.
2997 This parameter is ignored when opening a client process. When specified
2998 for a server process, the FAMILY, HOST and SERVICE args are ignored.
3000 :remote ADDRESS -- ADDRESS is the remote partner's address for the
3001 connection. This parameter is ignored when opening a stream server
3002 process. For a datagram server process, it specifies the initial
3003 setting of the remote datagram address. When specified for a client
3004 process, the FAMILY, HOST, and SERVICE args are ignored.
3006 The format of ADDRESS depends on the address family:
3007 - An IPv4 address is represented as an vector of integers [A B C D P]
3008 corresponding to numeric IP address A.B.C.D and port number P.
3009 - A local address is represented as a string with the address in the
3010 local address space.
3011 - An "unsupported family" address is represented by a cons (F . AV)
3012 where F is the family number and AV is a vector containing the socket
3013 address data with one element per address data byte. Do not rely on
3014 this format in portable code, as it may depend on implementation
3015 defined constants, data sizes, and data structure alignment.
3017 :coding CODING -- If CODING is a symbol, it specifies the coding
3018 system used for both reading and writing for this process. If CODING
3019 is a cons (DECODING . ENCODING), DECODING is used for reading, and
3020 ENCODING is used for writing.
3022 :nowait BOOL -- If BOOL is non-nil for a stream type client process,
3023 return without waiting for the connection to complete; instead, the
3024 sentinel function will be called with second arg matching "open" (if
3025 successful) or "failed" when the connect completes. Default is to use
3026 a blocking connect (i.e. wait) for stream type connections.
3028 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
3029 running when Emacs is exited.
3031 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
3032 In the stopped state, a server process does not accept new
3033 connections, and a client process does not handle incoming traffic.
3034 The stopped state is cleared by `continue-process' and set by
3037 :filter FILTER -- Install FILTER as the process filter.
3039 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
3040 process filter are multibyte, otherwise they are unibyte.
3041 If this keyword is not specified, the strings are multibyte if
3042 `default-enable-multibyte-characters' is non-nil.
3044 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
3046 :log LOG -- Install LOG as the server process log function. This
3047 function is called when the server accepts a network connection from a
3048 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
3049 is the server process, CLIENT is the new process for the connection,
3050 and MESSAGE is a string.
3052 :plist PLIST -- Install PLIST as the new process' initial plist.
3054 :server QLEN -- if QLEN is non-nil, create a server process for the
3055 specified FAMILY, SERVICE, and connection type (stream or datagram).
3056 If QLEN is an integer, it is used as the max. length of the server's
3057 pending connection queue (also known as the backlog); the default
3058 queue length is 5. Default is to create a client process.
3060 The following network options can be specified for this connection:
3062 :broadcast BOOL -- Allow send and receive of datagram broadcasts.
3063 :dontroute BOOL -- Only send to directly connected hosts.
3064 :keepalive BOOL -- Send keep-alive messages on network stream.
3065 :linger BOOL or TIMEOUT -- Send queued messages before closing.
3066 :oobinline BOOL -- Place out-of-band data in receive data stream.
3067 :priority INT -- Set protocol defined priority for sent packets.
3068 :reuseaddr BOOL -- Allow reusing a recently used local address
3069 (this is allowed by default for a server process).
3070 :bindtodevice NAME -- bind to interface NAME. Using this may require
3071 special privileges on some systems.
3073 Consult the relevant system programmer's manual pages for more
3074 information on using these options.
3077 A server process will listen for and accept connections from clients.
3078 When a client connection is accepted, a new network process is created
3079 for the connection with the following parameters:
3081 - The client's process name is constructed by concatenating the server
3082 process' NAME and a client identification string.
3083 - If the FILTER argument is non-nil, the client process will not get a
3084 separate process buffer; otherwise, the client's process buffer is a newly
3085 created buffer named after the server process' BUFFER name or process
3086 NAME concatenated with the client identification string.
3087 - The connection type and the process filter and sentinel parameters are
3088 inherited from the server process' TYPE, FILTER and SENTINEL.
3089 - The client process' contact info is set according to the client's
3090 addressing information (typically an IP address and a port number).
3091 - The client process' plist is initialized from the server's plist.
3093 Notice that the FILTER and SENTINEL args are never used directly by
3094 the server process. Also, the BUFFER argument is not used directly by
3095 the server process, but via the optional :log function, accepted (and
3096 failed) connections may be logged in the server process' buffer.
3098 The original argument list, modified with the actual connection
3099 information, is available via the `process-contact' function.
3101 usage: (make-network-process &rest ARGS) */)
3102 (int nargs
, Lisp_Object
*args
)
3105 Lisp_Object contact
;
3106 struct Lisp_Process
*p
;
3107 #ifdef HAVE_GETADDRINFO
3108 struct addrinfo ai
, *res
, *lres
;
3109 struct addrinfo hints
;
3110 char *portstring
, portbuf
[128];
3111 #else /* HAVE_GETADDRINFO */
3112 struct _emacs_addrinfo
3118 struct sockaddr
*ai_addr
;
3119 struct _emacs_addrinfo
*ai_next
;
3121 #endif /* HAVE_GETADDRINFO */
3122 struct sockaddr_in address_in
;
3123 #ifdef HAVE_LOCAL_SOCKETS
3124 struct sockaddr_un address_un
;
3129 int s
= -1, outch
, inch
;
3130 struct gcpro gcpro1
;
3131 int count
= SPECPDL_INDEX ();
3133 Lisp_Object QCaddress
; /* one of QClocal or QCremote */
3135 Lisp_Object name
, buffer
, host
, service
, address
;
3136 Lisp_Object filter
, sentinel
;
3137 int is_non_blocking_client
= 0;
3138 int is_server
= 0, backlog
= 5;
3145 /* Save arguments for process-contact and clone-process. */
3146 contact
= Flist (nargs
, args
);
3150 /* Ensure socket support is loaded if available. */
3151 init_winsock (TRUE
);
3154 /* :type TYPE (nil: stream, datagram */
3155 tem
= Fplist_get (contact
, QCtype
);
3157 socktype
= SOCK_STREAM
;
3158 #ifdef DATAGRAM_SOCKETS
3159 else if (EQ (tem
, Qdatagram
))
3160 socktype
= SOCK_DGRAM
;
3162 #ifdef HAVE_SEQPACKET
3163 else if (EQ (tem
, Qseqpacket
))
3164 socktype
= SOCK_SEQPACKET
;
3167 error ("Unsupported connection type");
3170 tem
= Fplist_get (contact
, QCserver
);
3173 /* Don't support network sockets when non-blocking mode is
3174 not available, since a blocked Emacs is not useful. */
3175 #if !defined(O_NONBLOCK) && !defined(O_NDELAY)
3176 error ("Network servers not supported");
3180 backlog
= XINT (tem
);
3184 /* Make QCaddress an alias for :local (server) or :remote (client). */
3185 QCaddress
= is_server
? QClocal
: QCremote
;
3188 if (!is_server
&& socktype
!= SOCK_DGRAM
3189 && (tem
= Fplist_get (contact
, QCnowait
), !NILP (tem
)))
3191 #ifndef NON_BLOCKING_CONNECT
3192 error ("Non-blocking connect not supported");
3194 is_non_blocking_client
= 1;
3198 name
= Fplist_get (contact
, QCname
);
3199 buffer
= Fplist_get (contact
, QCbuffer
);
3200 filter
= Fplist_get (contact
, QCfilter
);
3201 sentinel
= Fplist_get (contact
, QCsentinel
);
3203 CHECK_STRING (name
);
3205 /* Initialize addrinfo structure in case we don't use getaddrinfo. */
3206 ai
.ai_socktype
= socktype
;
3211 /* :local ADDRESS or :remote ADDRESS */
3212 address
= Fplist_get (contact
, QCaddress
);
3213 if (!NILP (address
))
3215 host
= service
= Qnil
;
3217 if (!(ai
.ai_addrlen
= get_lisp_to_sockaddr_size (address
, &family
)))
3218 error ("Malformed :address");
3219 ai
.ai_family
= family
;
3220 ai
.ai_addr
= alloca (ai
.ai_addrlen
);
3221 conv_lisp_to_sockaddr (family
, address
, ai
.ai_addr
, ai
.ai_addrlen
);
3225 /* :family FAMILY -- nil (for Inet), local, or integer. */
3226 tem
= Fplist_get (contact
, QCfamily
);
3229 #if defined(HAVE_GETADDRINFO) && defined(AF_INET6)
3235 #ifdef HAVE_LOCAL_SOCKETS
3236 else if (EQ (tem
, Qlocal
))
3240 else if (EQ (tem
, Qipv6
))
3243 else if (EQ (tem
, Qipv4
))
3245 else if (INTEGERP (tem
))
3246 family
= XINT (tem
);
3248 error ("Unknown address family");
3250 ai
.ai_family
= family
;
3252 /* :service SERVICE -- string, integer (port number), or t (random port). */
3253 service
= Fplist_get (contact
, QCservice
);
3255 /* :host HOST -- hostname, ip address, or 'local for localhost. */
3256 host
= Fplist_get (contact
, QChost
);
3259 if (EQ (host
, Qlocal
))
3260 host
= build_string ("localhost");
3261 CHECK_STRING (host
);
3264 #ifdef HAVE_LOCAL_SOCKETS
3265 if (family
== AF_LOCAL
)
3269 message (":family local ignores the :host \"%s\" property",
3271 contact
= Fplist_put (contact
, QChost
, Qnil
);
3274 CHECK_STRING (service
);
3275 memset (&address_un
, 0, sizeof address_un
);
3276 address_un
.sun_family
= AF_LOCAL
;
3277 strncpy (address_un
.sun_path
, SDATA (service
), sizeof address_un
.sun_path
);
3278 ai
.ai_addr
= (struct sockaddr
*) &address_un
;
3279 ai
.ai_addrlen
= sizeof address_un
;
3284 /* Slow down polling to every ten seconds.
3285 Some kernels have a bug which causes retrying connect to fail
3286 after a connect. Polling can interfere with gethostbyname too. */
3287 #ifdef POLL_FOR_INPUT
3288 if (socktype
!= SOCK_DGRAM
)
3290 record_unwind_protect (unwind_stop_other_atimers
, Qnil
);
3291 bind_polling_period (10);
3295 #ifdef HAVE_GETADDRINFO
3296 /* If we have a host, use getaddrinfo to resolve both host and service.
3297 Otherwise, use getservbyname to lookup the service. */
3301 /* SERVICE can either be a string or int.
3302 Convert to a C string for later use by getaddrinfo. */
3303 if (EQ (service
, Qt
))
3305 else if (INTEGERP (service
))
3307 sprintf (portbuf
, "%ld", (long) XINT (service
));
3308 portstring
= portbuf
;
3312 CHECK_STRING (service
);
3313 portstring
= SDATA (service
);
3318 memset (&hints
, 0, sizeof (hints
));
3320 hints
.ai_family
= family
;
3321 hints
.ai_socktype
= socktype
;
3322 hints
.ai_protocol
= 0;
3324 #ifdef HAVE_RES_INIT
3328 ret
= getaddrinfo (SDATA (host
), portstring
, &hints
, &res
);
3330 #ifdef HAVE_GAI_STRERROR
3331 error ("%s/%s %s", SDATA (host
), portstring
, gai_strerror (ret
));
3333 error ("%s/%s getaddrinfo error %d", SDATA (host
), portstring
, ret
);
3339 #endif /* HAVE_GETADDRINFO */
3341 /* We end up here if getaddrinfo is not defined, or in case no hostname
3342 has been specified (e.g. for a local server process). */
3344 if (EQ (service
, Qt
))
3346 else if (INTEGERP (service
))
3347 port
= htons ((unsigned short) XINT (service
));
3350 struct servent
*svc_info
;
3351 CHECK_STRING (service
);
3352 svc_info
= getservbyname (SDATA (service
),
3353 (socktype
== SOCK_DGRAM
? "udp" : "tcp"));
3355 error ("Unknown service: %s", SDATA (service
));
3356 port
= svc_info
->s_port
;
3359 memset (&address_in
, 0, sizeof address_in
);
3360 address_in
.sin_family
= family
;
3361 address_in
.sin_addr
.s_addr
= INADDR_ANY
;
3362 address_in
.sin_port
= port
;
3364 #ifndef HAVE_GETADDRINFO
3367 struct hostent
*host_info_ptr
;
3369 /* gethostbyname may fail with TRY_AGAIN, but we don't honour that,
3370 as it may `hang' Emacs for a very long time. */
3374 #ifdef HAVE_RES_INIT
3378 host_info_ptr
= gethostbyname (SDATA (host
));
3383 memcpy (&address_in
.sin_addr
, host_info_ptr
->h_addr
,
3384 host_info_ptr
->h_length
);
3385 family
= host_info_ptr
->h_addrtype
;
3386 address_in
.sin_family
= family
;
3389 /* Attempt to interpret host as numeric inet address */
3391 unsigned long numeric_addr
;
3392 numeric_addr
= inet_addr ((char *) SDATA (host
));
3393 if (numeric_addr
== -1)
3394 error ("Unknown host \"%s\"", SDATA (host
));
3396 memcpy (&address_in
.sin_addr
, &numeric_addr
,
3397 sizeof (address_in
.sin_addr
));
3401 #endif /* not HAVE_GETADDRINFO */
3403 ai
.ai_family
= family
;
3404 ai
.ai_addr
= (struct sockaddr
*) &address_in
;
3405 ai
.ai_addrlen
= sizeof address_in
;
3409 /* Do this in case we never enter the for-loop below. */
3410 count1
= SPECPDL_INDEX ();
3413 for (lres
= res
; lres
; lres
= lres
->ai_next
)
3419 s
= socket (lres
->ai_family
, lres
->ai_socktype
, lres
->ai_protocol
);
3426 #ifdef DATAGRAM_SOCKETS
3427 if (!is_server
&& socktype
== SOCK_DGRAM
)
3429 #endif /* DATAGRAM_SOCKETS */
3431 #ifdef NON_BLOCKING_CONNECT
3432 if (is_non_blocking_client
)
3435 ret
= fcntl (s
, F_SETFL
, O_NONBLOCK
);
3437 ret
= fcntl (s
, F_SETFL
, O_NDELAY
);
3449 /* Make us close S if quit. */
3450 record_unwind_protect (close_file_unwind
, make_number (s
));
3452 /* Parse network options in the arg list.
3453 We simply ignore anything which isn't a known option (including other keywords).
3454 An error is signaled if setting a known option fails. */
3455 for (optn
= optbits
= 0; optn
< nargs
-1; optn
+= 2)
3456 optbits
|= set_socket_option (s
, args
[optn
], args
[optn
+1]);
3460 /* Configure as a server socket. */
3462 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3463 explicit :reuseaddr key to override this. */
3464 #ifdef HAVE_LOCAL_SOCKETS
3465 if (family
!= AF_LOCAL
)
3467 if (!(optbits
& (1 << OPIX_REUSEADDR
)))
3470 if (setsockopt (s
, SOL_SOCKET
, SO_REUSEADDR
, &optval
, sizeof optval
))
3471 report_file_error ("Cannot set reuse option on server socket", Qnil
);
3474 if (bind (s
, lres
->ai_addr
, lres
->ai_addrlen
))
3475 report_file_error ("Cannot bind server socket", Qnil
);
3477 #ifdef HAVE_GETSOCKNAME
3478 if (EQ (service
, Qt
))
3480 struct sockaddr_in sa1
;
3481 int len1
= sizeof (sa1
);
3482 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3484 ((struct sockaddr_in
*)(lres
->ai_addr
))->sin_port
= sa1
.sin_port
;
3485 service
= make_number (ntohs (sa1
.sin_port
));
3486 contact
= Fplist_put (contact
, QCservice
, service
);
3491 if (socktype
!= SOCK_DGRAM
&& listen (s
, backlog
))
3492 report_file_error ("Cannot listen on server socket", Qnil
);
3500 ret
= connect (s
, lres
->ai_addr
, lres
->ai_addrlen
);
3503 if (ret
== 0 || xerrno
== EISCONN
)
3505 /* The unwind-protect will be discarded afterwards.
3506 Likewise for immediate_quit. */
3510 #ifdef NON_BLOCKING_CONNECT
3512 if (is_non_blocking_client
&& xerrno
== EINPROGRESS
)
3516 if (is_non_blocking_client
&& xerrno
== EWOULDBLOCK
)
3523 if (xerrno
== EINTR
)
3525 /* Unlike most other syscalls connect() cannot be called
3526 again. (That would return EALREADY.) The proper way to
3527 wait for completion is select(). */
3534 sc
= select (s
+ 1, (SELECT_TYPE
*)0, &fdset
, (SELECT_TYPE
*)0,
3541 report_file_error ("select failed", Qnil
);
3545 len
= sizeof xerrno
;
3546 eassert (FD_ISSET (s
, &fdset
));
3547 if (getsockopt (s
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &len
) == -1)
3548 report_file_error ("getsockopt failed", Qnil
);
3550 errno
= xerrno
, report_file_error ("error during connect", Qnil
);
3554 #endif /* !WINDOWSNT */
3558 /* Discard the unwind protect closing S. */
3559 specpdl_ptr
= specpdl
+ count1
;
3564 if (xerrno
== EINTR
)
3571 #ifdef DATAGRAM_SOCKETS
3572 if (socktype
== SOCK_DGRAM
)
3574 if (datagram_address
[s
].sa
)
3576 datagram_address
[s
].sa
= (struct sockaddr
*) xmalloc (lres
->ai_addrlen
);
3577 datagram_address
[s
].len
= lres
->ai_addrlen
;
3581 memset (datagram_address
[s
].sa
, 0, lres
->ai_addrlen
);
3582 if (remote
= Fplist_get (contact
, QCremote
), !NILP (remote
))
3585 rlen
= get_lisp_to_sockaddr_size (remote
, &rfamily
);
3586 if (rfamily
== lres
->ai_family
&& rlen
== lres
->ai_addrlen
)
3587 conv_lisp_to_sockaddr (rfamily
, remote
,
3588 datagram_address
[s
].sa
, rlen
);
3592 memcpy (datagram_address
[s
].sa
, lres
->ai_addr
, lres
->ai_addrlen
);
3595 contact
= Fplist_put (contact
, QCaddress
,
3596 conv_sockaddr_to_lisp (lres
->ai_addr
, lres
->ai_addrlen
));
3597 #ifdef HAVE_GETSOCKNAME
3600 struct sockaddr_in sa1
;
3601 int len1
= sizeof (sa1
);
3602 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3603 contact
= Fplist_put (contact
, QClocal
,
3604 conv_sockaddr_to_lisp ((struct sockaddr
*)&sa1
, len1
));
3611 #ifdef HAVE_GETADDRINFO
3620 /* Discard the unwind protect for closing S, if any. */
3621 specpdl_ptr
= specpdl
+ count1
;
3623 /* Unwind bind_polling_period and request_sigio. */
3624 unbind_to (count
, Qnil
);
3628 /* If non-blocking got this far - and failed - assume non-blocking is
3629 not supported after all. This is probably a wrong assumption, but
3630 the normal blocking calls to open-network-stream handles this error
3632 if (is_non_blocking_client
)
3637 report_file_error ("make server process failed", contact
);
3639 report_file_error ("make client process failed", contact
);
3646 buffer
= Fget_buffer_create (buffer
);
3647 proc
= make_process (name
);
3649 chan_process
[inch
] = proc
;
3652 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
3655 fcntl (inch
, F_SETFL
, O_NDELAY
);
3659 p
= XPROCESS (proc
);
3661 p
->childp
= contact
;
3662 p
->plist
= Fcopy_sequence (Fplist_get (contact
, QCplist
));
3666 p
->sentinel
= sentinel
;
3668 p
->log
= Fplist_get (contact
, QClog
);
3669 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
3670 p
->kill_without_query
= 1;
3671 if ((tem
= Fplist_get (contact
, QCstop
), !NILP (tem
)))
3676 if (is_server
&& socktype
!= SOCK_DGRAM
)
3677 p
->status
= Qlisten
;
3679 /* Make the process marker point into the process buffer (if any). */
3680 if (BUFFERP (buffer
))
3681 set_marker_both (p
->mark
, buffer
,
3682 BUF_ZV (XBUFFER (buffer
)),
3683 BUF_ZV_BYTE (XBUFFER (buffer
)));
3685 #ifdef NON_BLOCKING_CONNECT
3686 if (is_non_blocking_client
)
3688 /* We may get here if connect did succeed immediately. However,
3689 in that case, we still need to signal this like a non-blocking
3691 p
->status
= Qconnect
;
3692 if (!FD_ISSET (inch
, &connect_wait_mask
))
3694 FD_SET (inch
, &connect_wait_mask
);
3695 num_pending_connects
++;
3700 /* A server may have a client filter setting of Qt, but it must
3701 still listen for incoming connects unless it is stopped. */
3702 if ((!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
3703 || (EQ (p
->status
, Qlisten
) && NILP (p
->command
)))
3705 FD_SET (inch
, &input_wait_mask
);
3706 FD_SET (inch
, &non_keyboard_wait_mask
);
3709 if (inch
> max_process_desc
)
3710 max_process_desc
= inch
;
3712 tem
= Fplist_member (contact
, QCcoding
);
3713 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
3714 tem
= Qnil
; /* No error message (too late!). */
3717 /* Setup coding systems for communicating with the network stream. */
3718 struct gcpro gcpro1
;
3719 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3720 Lisp_Object coding_systems
= Qt
;
3721 Lisp_Object args
[5], val
;
3725 val
= XCAR (XCDR (tem
));
3729 else if (!NILP (Vcoding_system_for_read
))
3730 val
= Vcoding_system_for_read
;
3731 else if ((!NILP (buffer
) && NILP (XBUFFER (buffer
)->enable_multibyte_characters
))
3732 || (NILP (buffer
) && NILP (buffer_defaults
.enable_multibyte_characters
)))
3733 /* We dare not decode end-of-line format by setting VAL to
3734 Qraw_text, because the existing Emacs Lisp libraries
3735 assume that they receive bare code including a sequene of
3740 if (NILP (host
) || NILP (service
))
3741 coding_systems
= Qnil
;
3744 args
[0] = Qopen_network_stream
, args
[1] = name
,
3745 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3747 coding_systems
= Ffind_operation_coding_system (5, args
);
3750 if (CONSP (coding_systems
))
3751 val
= XCAR (coding_systems
);
3752 else if (CONSP (Vdefault_process_coding_system
))
3753 val
= XCAR (Vdefault_process_coding_system
);
3757 p
->decode_coding_system
= val
;
3761 val
= XCAR (XCDR (tem
));
3765 else if (!NILP (Vcoding_system_for_write
))
3766 val
= Vcoding_system_for_write
;
3767 else if (NILP (current_buffer
->enable_multibyte_characters
))
3771 if (EQ (coding_systems
, Qt
))
3773 if (NILP (host
) || NILP (service
))
3774 coding_systems
= Qnil
;
3777 args
[0] = Qopen_network_stream
, args
[1] = name
,
3778 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3780 coding_systems
= Ffind_operation_coding_system (5, args
);
3784 if (CONSP (coding_systems
))
3785 val
= XCDR (coding_systems
);
3786 else if (CONSP (Vdefault_process_coding_system
))
3787 val
= XCDR (Vdefault_process_coding_system
);
3791 p
->encode_coding_system
= val
;
3793 setup_process_coding_systems (proc
);
3795 p
->decoding_buf
= make_uninit_string (0);
3796 p
->decoding_carryover
= 0;
3797 p
->encoding_buf
= make_uninit_string (0);
3799 p
->inherit_coding_system_flag
3800 = !(!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
);
3805 #endif /* HAVE_SOCKETS */
3808 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
3811 DEFUN ("network-interface-list", Fnetwork_interface_list
, Snetwork_interface_list
, 0, 0, 0,
3812 doc
: /* Return an alist of all network interfaces and their network address.
3813 Each element is a cons, the car of which is a string containing the
3814 interface name, and the cdr is the network address in internal
3815 format; see the description of ADDRESS in `make-network-process'. */)
3818 struct ifconf ifconf
;
3819 struct ifreq
*ifreqs
= NULL
;
3824 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3830 buf_size
= ifaces
* sizeof (ifreqs
[0]);
3831 ifreqs
= (struct ifreq
*)xrealloc(ifreqs
, buf_size
);
3838 ifconf
.ifc_len
= buf_size
;
3839 ifconf
.ifc_req
= ifreqs
;
3840 if (ioctl (s
, SIOCGIFCONF
, &ifconf
))
3846 if (ifconf
.ifc_len
== buf_size
)
3850 ifaces
= ifconf
.ifc_len
/ sizeof (ifreqs
[0]);
3853 while (--ifaces
>= 0)
3855 struct ifreq
*ifq
= &ifreqs
[ifaces
];
3856 char namebuf
[sizeof (ifq
->ifr_name
) + 1];
3857 if (ifq
->ifr_addr
.sa_family
!= AF_INET
)
3859 memcpy (namebuf
, ifq
->ifr_name
, sizeof (ifq
->ifr_name
));
3860 namebuf
[sizeof (ifq
->ifr_name
)] = 0;
3861 res
= Fcons (Fcons (build_string (namebuf
),
3862 conv_sockaddr_to_lisp (&ifq
->ifr_addr
,
3863 sizeof (struct sockaddr
))),
3869 #endif /* SIOCGIFCONF */
3871 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
3875 const char *flag_sym
;
3878 static const struct ifflag_def ifflag_table
[] = {
3882 #ifdef IFF_BROADCAST
3883 { IFF_BROADCAST
, "broadcast" },
3886 { IFF_DEBUG
, "debug" },
3889 { IFF_LOOPBACK
, "loopback" },
3891 #ifdef IFF_POINTOPOINT
3892 { IFF_POINTOPOINT
, "pointopoint" },
3895 { IFF_RUNNING
, "running" },
3898 { IFF_NOARP
, "noarp" },
3901 { IFF_PROMISC
, "promisc" },
3903 #ifdef IFF_NOTRAILERS
3904 { IFF_NOTRAILERS
, "notrailers" },
3907 { IFF_ALLMULTI
, "allmulti" },
3910 { IFF_MASTER
, "master" },
3913 { IFF_SLAVE
, "slave" },
3915 #ifdef IFF_MULTICAST
3916 { IFF_MULTICAST
, "multicast" },
3919 { IFF_PORTSEL
, "portsel" },
3921 #ifdef IFF_AUTOMEDIA
3922 { IFF_AUTOMEDIA
, "automedia" },
3925 { IFF_DYNAMIC
, "dynamic" },
3928 { IFF_OACTIVE
, "oactive" }, /* OpenBSD: transmission in progress */
3931 { IFF_SIMPLEX
, "simplex" }, /* OpenBSD: can't hear own transmissions */
3934 { IFF_LINK0
, "link0" }, /* OpenBSD: per link layer defined bit */
3937 { IFF_LINK1
, "link1" }, /* OpenBSD: per link layer defined bit */
3940 { IFF_LINK2
, "link2" }, /* OpenBSD: per link layer defined bit */
3945 DEFUN ("network-interface-info", Fnetwork_interface_info
, Snetwork_interface_info
, 1, 1, 0,
3946 doc
: /* Return information about network interface named IFNAME.
3947 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
3948 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
3949 NETMASK is the layer 3 network mask, HWADDR is the layer 2 addres, and
3950 FLAGS is the current flags of the interface. */)
3951 (Lisp_Object ifname
)
3954 Lisp_Object res
= Qnil
;
3959 CHECK_STRING (ifname
);
3961 memset (rq
.ifr_name
, 0, sizeof rq
.ifr_name
);
3962 strncpy (rq
.ifr_name
, SDATA (ifname
), sizeof (rq
.ifr_name
));
3964 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3969 #if defined(SIOCGIFFLAGS) && defined(HAVE_STRUCT_IFREQ_IFR_FLAGS)
3970 if (ioctl (s
, SIOCGIFFLAGS
, &rq
) == 0)
3972 int flags
= rq
.ifr_flags
;
3973 const struct ifflag_def
*fp
;
3977 for (fp
= ifflag_table
; flags
!= 0 && fp
->flag_sym
; fp
++)
3979 if (flags
& fp
->flag_bit
)
3981 elt
= Fcons (intern (fp
->flag_sym
), elt
);
3982 flags
-= fp
->flag_bit
;
3985 for (fnum
= 0; flags
&& fnum
< 32; fnum
++)
3987 if (flags
& (1 << fnum
))
3989 elt
= Fcons (make_number (fnum
), elt
);
3994 res
= Fcons (elt
, res
);
3997 #if defined(SIOCGIFHWADDR) && defined(HAVE_STRUCT_IFREQ_IFR_HWADDR)
3998 if (ioctl (s
, SIOCGIFHWADDR
, &rq
) == 0)
4000 Lisp_Object hwaddr
= Fmake_vector (make_number (6), Qnil
);
4001 register struct Lisp_Vector
*p
= XVECTOR (hwaddr
);
4005 for (n
= 0; n
< 6; n
++)
4006 p
->contents
[n
] = make_number (((unsigned char *)&rq
.ifr_hwaddr
.sa_data
[0])[n
]);
4007 elt
= Fcons (make_number (rq
.ifr_hwaddr
.sa_family
), hwaddr
);
4010 res
= Fcons (elt
, res
);
4013 #if defined(SIOCGIFNETMASK) && (defined(HAVE_STRUCT_IFREQ_IFR_NETMASK) || defined(HAVE_STRUCT_IFREQ_IFR_ADDR))
4014 if (ioctl (s
, SIOCGIFNETMASK
, &rq
) == 0)
4017 #ifdef HAVE_STRUCT_IFREQ_IFR_NETMASK
4018 elt
= conv_sockaddr_to_lisp (&rq
.ifr_netmask
, sizeof (rq
.ifr_netmask
));
4020 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
4024 res
= Fcons (elt
, res
);
4027 #if defined(SIOCGIFBRDADDR) && defined(HAVE_STRUCT_IFREQ_IFR_BROADADDR)
4028 if (ioctl (s
, SIOCGIFBRDADDR
, &rq
) == 0)
4031 elt
= conv_sockaddr_to_lisp (&rq
.ifr_broadaddr
, sizeof (rq
.ifr_broadaddr
));
4034 res
= Fcons (elt
, res
);
4037 #if defined(SIOCGIFADDR) && defined(HAVE_STRUCT_IFREQ_IFR_ADDR)
4038 if (ioctl (s
, SIOCGIFADDR
, &rq
) == 0)
4041 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
4044 res
= Fcons (elt
, res
);
4048 return any
? res
: Qnil
;
4051 #endif /* HAVE_SOCKETS */
4053 /* Turn off input and output for process PROC. */
4056 deactivate_process (Lisp_Object proc
)
4058 register int inchannel
, outchannel
;
4059 register struct Lisp_Process
*p
= XPROCESS (proc
);
4061 inchannel
= p
->infd
;
4062 outchannel
= p
->outfd
;
4064 #ifdef ADAPTIVE_READ_BUFFERING
4065 if (p
->read_output_delay
> 0)
4067 if (--process_output_delay_count
< 0)
4068 process_output_delay_count
= 0;
4069 p
->read_output_delay
= 0;
4070 p
->read_output_skip
= 0;
4076 /* Beware SIGCHLD hereabouts. */
4077 flush_pending_output (inchannel
);
4078 emacs_close (inchannel
);
4079 if (outchannel
>= 0 && outchannel
!= inchannel
)
4080 emacs_close (outchannel
);
4084 #ifdef DATAGRAM_SOCKETS
4085 if (DATAGRAM_CHAN_P (inchannel
))
4087 xfree (datagram_address
[inchannel
].sa
);
4088 datagram_address
[inchannel
].sa
= 0;
4089 datagram_address
[inchannel
].len
= 0;
4092 chan_process
[inchannel
] = Qnil
;
4093 FD_CLR (inchannel
, &input_wait_mask
);
4094 FD_CLR (inchannel
, &non_keyboard_wait_mask
);
4095 #ifdef NON_BLOCKING_CONNECT
4096 if (FD_ISSET (inchannel
, &connect_wait_mask
))
4098 FD_CLR (inchannel
, &connect_wait_mask
);
4099 if (--num_pending_connects
< 0)
4103 if (inchannel
== max_process_desc
)
4106 /* We just closed the highest-numbered process input descriptor,
4107 so recompute the highest-numbered one now. */
4108 max_process_desc
= 0;
4109 for (i
= 0; i
< MAXDESC
; i
++)
4110 if (!NILP (chan_process
[i
]))
4111 max_process_desc
= i
;
4116 /* Close all descriptors currently in use for communication
4117 with subprocess. This is used in a newly-forked subprocess
4118 to get rid of irrelevant descriptors. */
4121 close_process_descs (void)
4125 for (i
= 0; i
< MAXDESC
; i
++)
4127 Lisp_Object process
;
4128 process
= chan_process
[i
];
4129 if (!NILP (process
))
4131 int in
= XPROCESS (process
)->infd
;
4132 int out
= XPROCESS (process
)->outfd
;
4135 if (out
>= 0 && in
!= out
)
4142 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
4144 doc
: /* Allow any pending output from subprocesses to be read by Emacs.
4145 It is read into the process' buffers or given to their filter functions.
4146 Non-nil arg PROCESS means do not return until some output has been received
4149 Non-nil second arg SECONDS and third arg MILLISEC are number of seconds
4150 and milliseconds to wait; return after that much time whether or not
4151 there is any subprocess output. If SECONDS is a floating point number,
4152 it specifies a fractional number of seconds to wait.
4153 The MILLISEC argument is obsolete and should be avoided.
4155 If optional fourth arg JUST-THIS-ONE is non-nil, only accept output
4156 from PROCESS, suspending reading output from other processes.
4157 If JUST-THIS-ONE is an integer, don't run any timers either.
4158 Return non-nil if we received any output before the timeout expired. */)
4159 (register Lisp_Object process
, Lisp_Object seconds
, Lisp_Object millisec
, Lisp_Object just_this_one
)
4161 int secs
, usecs
= 0;
4163 if (! NILP (process
))
4164 CHECK_PROCESS (process
);
4166 just_this_one
= Qnil
;
4168 if (!NILP (millisec
))
4169 { /* Obsolete calling convention using integers rather than floats. */
4170 CHECK_NUMBER (millisec
);
4172 seconds
= make_float (XINT (millisec
) / 1000.0);
4175 CHECK_NUMBER (seconds
);
4176 seconds
= make_float (XINT (millisec
) / 1000.0 + XINT (seconds
));
4180 if (!NILP (seconds
))
4182 if (INTEGERP (seconds
))
4183 secs
= XINT (seconds
);
4184 else if (FLOATP (seconds
))
4186 double timeout
= XFLOAT_DATA (seconds
);
4187 secs
= (int) timeout
;
4188 usecs
= (int) ((timeout
- (double) secs
) * 1000000);
4191 wrong_type_argument (Qnumberp
, seconds
);
4193 if (secs
< 0 || (secs
== 0 && usecs
== 0))
4194 secs
= -1, usecs
= 0;
4197 secs
= NILP (process
) ? -1 : 0;
4200 (wait_reading_process_output (secs
, usecs
, 0, 0,
4202 !NILP (process
) ? XPROCESS (process
) : NULL
,
4203 NILP (just_this_one
) ? 0 :
4204 !INTEGERP (just_this_one
) ? 1 : -1)
4208 /* Accept a connection for server process SERVER on CHANNEL. */
4210 static int connect_counter
= 0;
4213 server_accept_connection (Lisp_Object server
, int channel
)
4215 Lisp_Object proc
, caller
, name
, buffer
;
4216 Lisp_Object contact
, host
, service
;
4217 struct Lisp_Process
*ps
= XPROCESS (server
);
4218 struct Lisp_Process
*p
;
4222 struct sockaddr_in in
;
4224 struct sockaddr_in6 in6
;
4226 #ifdef HAVE_LOCAL_SOCKETS
4227 struct sockaddr_un un
;
4230 int len
= sizeof saddr
;
4232 s
= accept (channel
, &saddr
.sa
, &len
);
4241 if (code
== EWOULDBLOCK
)
4245 if (!NILP (ps
->log
))
4246 call3 (ps
->log
, server
, Qnil
,
4247 concat3 (build_string ("accept failed with code"),
4248 Fnumber_to_string (make_number (code
)),
4249 build_string ("\n")));
4255 /* Setup a new process to handle the connection. */
4257 /* Generate a unique identification of the caller, and build contact
4258 information for this process. */
4261 switch (saddr
.sa
.sa_family
)
4265 Lisp_Object args
[5];
4266 unsigned char *ip
= (unsigned char *)&saddr
.in
.sin_addr
.s_addr
;
4267 args
[0] = build_string ("%d.%d.%d.%d");
4268 args
[1] = make_number (*ip
++);
4269 args
[2] = make_number (*ip
++);
4270 args
[3] = make_number (*ip
++);
4271 args
[4] = make_number (*ip
++);
4272 host
= Fformat (5, args
);
4273 service
= make_number (ntohs (saddr
.in
.sin_port
));
4275 args
[0] = build_string (" <%s:%d>");
4278 caller
= Fformat (3, args
);
4285 Lisp_Object args
[9];
4286 uint16_t *ip6
= (uint16_t *)&saddr
.in6
.sin6_addr
;
4288 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
4289 for (i
= 0; i
< 8; i
++)
4290 args
[i
+1] = make_number (ntohs (ip6
[i
]));
4291 host
= Fformat (9, args
);
4292 service
= make_number (ntohs (saddr
.in
.sin_port
));
4294 args
[0] = build_string (" <[%s]:%d>");
4297 caller
= Fformat (3, args
);
4302 #ifdef HAVE_LOCAL_SOCKETS
4306 caller
= Fnumber_to_string (make_number (connect_counter
));
4307 caller
= concat3 (build_string (" <"), caller
, build_string (">"));
4311 /* Create a new buffer name for this process if it doesn't have a
4312 filter. The new buffer name is based on the buffer name or
4313 process name of the server process concatenated with the caller
4316 if (!NILP (ps
->filter
) && !EQ (ps
->filter
, Qt
))
4320 buffer
= ps
->buffer
;
4322 buffer
= Fbuffer_name (buffer
);
4327 buffer
= concat2 (buffer
, caller
);
4328 buffer
= Fget_buffer_create (buffer
);
4332 /* Generate a unique name for the new server process. Combine the
4333 server process name with the caller identification. */
4335 name
= concat2 (ps
->name
, caller
);
4336 proc
= make_process (name
);
4338 chan_process
[s
] = proc
;
4341 fcntl (s
, F_SETFL
, O_NONBLOCK
);
4344 fcntl (s
, F_SETFL
, O_NDELAY
);
4348 p
= XPROCESS (proc
);
4350 /* Build new contact information for this setup. */
4351 contact
= Fcopy_sequence (ps
->childp
);
4352 contact
= Fplist_put (contact
, QCserver
, Qnil
);
4353 contact
= Fplist_put (contact
, QChost
, host
);
4354 if (!NILP (service
))
4355 contact
= Fplist_put (contact
, QCservice
, service
);
4356 contact
= Fplist_put (contact
, QCremote
,
4357 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4358 #ifdef HAVE_GETSOCKNAME
4360 if (getsockname (s
, &saddr
.sa
, &len
) == 0)
4361 contact
= Fplist_put (contact
, QClocal
,
4362 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4365 p
->childp
= contact
;
4366 p
->plist
= Fcopy_sequence (ps
->plist
);
4370 p
->sentinel
= ps
->sentinel
;
4371 p
->filter
= ps
->filter
;
4378 /* Client processes for accepted connections are not stopped initially. */
4379 if (!EQ (p
->filter
, Qt
))
4381 FD_SET (s
, &input_wait_mask
);
4382 FD_SET (s
, &non_keyboard_wait_mask
);
4385 if (s
> max_process_desc
)
4386 max_process_desc
= s
;
4388 /* Setup coding system for new process based on server process.
4389 This seems to be the proper thing to do, as the coding system
4390 of the new process should reflect the settings at the time the
4391 server socket was opened; not the current settings. */
4393 p
->decode_coding_system
= ps
->decode_coding_system
;
4394 p
->encode_coding_system
= ps
->encode_coding_system
;
4395 setup_process_coding_systems (proc
);
4397 p
->decoding_buf
= make_uninit_string (0);
4398 p
->decoding_carryover
= 0;
4399 p
->encoding_buf
= make_uninit_string (0);
4401 p
->inherit_coding_system_flag
4402 = (NILP (buffer
) ? 0 : ps
->inherit_coding_system_flag
);
4404 if (!NILP (ps
->log
))
4405 call3 (ps
->log
, server
, proc
,
4406 concat3 (build_string ("accept from "),
4407 (STRINGP (host
) ? host
: build_string ("-")),
4408 build_string ("\n")));
4410 if (!NILP (p
->sentinel
))
4411 exec_sentinel (proc
,
4412 concat3 (build_string ("open from "),
4413 (STRINGP (host
) ? host
: build_string ("-")),
4414 build_string ("\n")));
4417 /* This variable is different from waiting_for_input in keyboard.c.
4418 It is used to communicate to a lisp process-filter/sentinel (via the
4419 function Fwaiting_for_user_input_p below) whether Emacs was waiting
4420 for user-input when that process-filter was called.
4421 waiting_for_input cannot be used as that is by definition 0 when
4422 lisp code is being evalled.
4423 This is also used in record_asynch_buffer_change.
4424 For that purpose, this must be 0
4425 when not inside wait_reading_process_output. */
4426 static int waiting_for_user_input_p
;
4429 wait_reading_process_output_unwind (Lisp_Object data
)
4431 waiting_for_user_input_p
= XINT (data
);
4435 /* This is here so breakpoints can be put on it. */
4437 wait_reading_process_output_1 (void)
4441 /* Use a wrapper around select to work around a bug in gdb 5.3.
4442 Normally, the wrapper is optimized away by inlining.
4444 If emacs is stopped inside select, the gdb backtrace doesn't
4445 show the function which called select, so it is practically
4446 impossible to step through wait_reading_process_output. */
4450 select_wrapper (int n
, fd_set
*rfd
, fd_set
*wfd
, fd_set
*xfd
, struct timeval
*tmo
)
4452 return select (n
, rfd
, wfd
, xfd
, tmo
);
4454 #define select select_wrapper
4457 /* Read and dispose of subprocess output while waiting for timeout to
4458 elapse and/or keyboard input to be available.
4461 timeout in seconds, or
4462 zero for no limit, or
4463 -1 means gobble data immediately available but don't wait for any.
4466 an additional duration to wait, measured in microseconds.
4467 If this is nonzero and time_limit is 0, then the timeout
4468 consists of MICROSECS only.
4470 READ_KBD is a lisp value:
4471 0 to ignore keyboard input, or
4472 1 to return when input is available, or
4473 -1 meaning caller will actually read the input, so don't throw to
4474 the quit handler, or
4476 DO_DISPLAY != 0 means redisplay should be done to show subprocess
4477 output that arrives.
4479 If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil
4480 (and gobble terminal input into the buffer if any arrives).
4482 If WAIT_PROC is specified, wait until something arrives from that
4483 process. The return value is true if we read some input from
4486 If JUST_WAIT_PROC is non-nil, handle only output from WAIT_PROC
4487 (suspending output from other processes). A negative value
4488 means don't run any timers either.
4490 If WAIT_PROC is specified, then the function returns true if we
4491 received input from that process before the timeout elapsed.
4492 Otherwise, return true if we received input from any process. */
4495 wait_reading_process_output (time_limit
, microsecs
, read_kbd
, do_display
,
4496 wait_for_cell
, wait_proc
, just_wait_proc
)
4497 int time_limit
, microsecs
, read_kbd
, do_display
;
4498 Lisp_Object wait_for_cell
;
4499 struct Lisp_Process
*wait_proc
;
4502 register int channel
, nfds
;
4503 SELECT_TYPE Available
;
4504 #ifdef NON_BLOCKING_CONNECT
4505 SELECT_TYPE Connecting
;
4508 int check_delay
, no_avail
;
4511 EMACS_TIME timeout
, end_time
;
4512 int wait_channel
= -1;
4513 int got_some_input
= 0;
4514 int count
= SPECPDL_INDEX ();
4516 FD_ZERO (&Available
);
4517 #ifdef NON_BLOCKING_CONNECT
4518 FD_ZERO (&Connecting
);
4521 if (time_limit
== 0 && wait_proc
&& !NILP (Vinhibit_quit
)
4522 && !(CONSP (wait_proc
->status
) && EQ (XCAR (wait_proc
->status
), Qexit
)))
4523 message ("Blocking call to accept-process-output with quit inhibited!!");
4525 /* If wait_proc is a process to watch, set wait_channel accordingly. */
4526 if (wait_proc
!= NULL
)
4527 wait_channel
= wait_proc
->infd
;
4529 record_unwind_protect (wait_reading_process_output_unwind
,
4530 make_number (waiting_for_user_input_p
));
4531 waiting_for_user_input_p
= read_kbd
;
4533 /* Since we may need to wait several times,
4534 compute the absolute time to return at. */
4535 if (time_limit
|| microsecs
)
4537 EMACS_GET_TIME (end_time
);
4538 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
4539 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
4544 int timeout_reduced_for_timers
= 0;
4546 /* If calling from keyboard input, do not quit
4547 since we want to return C-g as an input character.
4548 Otherwise, do pending quit if requested. */
4553 process_pending_signals ();
4556 /* Exit now if the cell we're waiting for became non-nil. */
4557 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4560 /* Compute time from now till when time limit is up */
4561 /* Exit if already run out */
4562 if (time_limit
== -1)
4564 /* -1 specified for timeout means
4565 gobble output available now
4566 but don't wait at all. */
4568 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4570 else if (time_limit
|| microsecs
)
4572 EMACS_GET_TIME (timeout
);
4573 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
4574 if (EMACS_TIME_NEG_P (timeout
))
4579 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
4582 /* Normally we run timers here.
4583 But not if wait_for_cell; in those cases,
4584 the wait is supposed to be short,
4585 and those callers cannot handle running arbitrary Lisp code here. */
4586 if (NILP (wait_for_cell
)
4587 && just_wait_proc
>= 0)
4589 EMACS_TIME timer_delay
;
4593 int old_timers_run
= timers_run
;
4594 struct buffer
*old_buffer
= current_buffer
;
4595 Lisp_Object old_window
= selected_window
;
4597 timer_delay
= timer_check (1);
4599 /* If a timer has run, this might have changed buffers
4600 an alike. Make read_key_sequence aware of that. */
4601 if (timers_run
!= old_timers_run
4602 && (old_buffer
!= current_buffer
4603 || !EQ (old_window
, selected_window
))
4604 && waiting_for_user_input_p
== -1)
4605 record_asynch_buffer_change ();
4607 if (timers_run
!= old_timers_run
&& do_display
)
4608 /* We must retry, since a timer may have requeued itself
4609 and that could alter the time_delay. */
4610 redisplay_preserve_echo_area (9);
4614 while (!detect_input_pending ());
4616 /* If there is unread keyboard input, also return. */
4618 && requeued_events_pending_p ())
4621 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
4623 EMACS_TIME difference
;
4624 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
4625 if (EMACS_TIME_NEG_P (difference
))
4627 timeout
= timer_delay
;
4628 timeout_reduced_for_timers
= 1;
4631 /* If time_limit is -1, we are not going to wait at all. */
4632 else if (time_limit
!= -1)
4634 /* This is so a breakpoint can be put here. */
4635 wait_reading_process_output_1 ();
4639 /* Cause C-g and alarm signals to take immediate action,
4640 and cause input available signals to zero out timeout.
4642 It is important that we do this before checking for process
4643 activity. If we get a SIGCHLD after the explicit checks for
4644 process activity, timeout is the only way we will know. */
4646 set_waiting_for_input (&timeout
);
4648 /* If status of something has changed, and no input is
4649 available, notify the user of the change right away. After
4650 this explicit check, we'll let the SIGCHLD handler zap
4651 timeout to get our attention. */
4652 if (update_tick
!= process_tick
)
4655 #ifdef NON_BLOCKING_CONNECT
4659 if (kbd_on_hold_p ())
4662 Atemp
= input_wait_mask
;
4663 IF_NON_BLOCKING_CONNECT (Ctemp
= connect_wait_mask
);
4665 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4666 if ((select (max (max (max_process_desc
, max_keyboard_desc
),
4669 #ifdef NON_BLOCKING_CONNECT
4670 (num_pending_connects
> 0 ? &Ctemp
: (SELECT_TYPE
*)0),
4674 (SELECT_TYPE
*)0, &timeout
)
4677 /* It's okay for us to do this and then continue with
4678 the loop, since timeout has already been zeroed out. */
4679 clear_waiting_for_input ();
4680 status_notify (NULL
);
4681 if (do_display
) redisplay_preserve_echo_area (13);
4685 /* Don't wait for output from a non-running process. Just
4686 read whatever data has already been received. */
4687 if (wait_proc
&& wait_proc
->raw_status_new
)
4688 update_status (wait_proc
);
4690 && ! EQ (wait_proc
->status
, Qrun
)
4691 && ! EQ (wait_proc
->status
, Qconnect
))
4693 int nread
, total_nread
= 0;
4695 clear_waiting_for_input ();
4696 XSETPROCESS (proc
, wait_proc
);
4698 /* Read data from the process, until we exhaust it. */
4699 while (wait_proc
->infd
>= 0)
4701 nread
= read_process_output (proc
, wait_proc
->infd
);
4708 total_nread
+= nread
;
4712 else if (nread
== -1 && EIO
== errno
)
4716 else if (nread
== -1 && EAGAIN
== errno
)
4720 else if (nread
== -1 && EWOULDBLOCK
== errno
)
4724 if (total_nread
> 0 && do_display
)
4725 redisplay_preserve_echo_area (10);
4730 /* Wait till there is something to do */
4732 if (wait_proc
&& just_wait_proc
)
4734 if (wait_proc
->infd
< 0) /* Terminated */
4736 FD_SET (wait_proc
->infd
, &Available
);
4738 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4740 else if (!NILP (wait_for_cell
))
4742 Available
= non_process_wait_mask
;
4744 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4749 Available
= non_keyboard_wait_mask
;
4751 Available
= input_wait_mask
;
4752 IF_NON_BLOCKING_CONNECT (check_connect
= (num_pending_connects
> 0));
4753 check_delay
= wait_channel
>= 0 ? 0 : process_output_delay_count
;
4756 /* If frame size has changed or the window is newly mapped,
4757 redisplay now, before we start to wait. There is a race
4758 condition here; if a SIGIO arrives between now and the select
4759 and indicates that a frame is trashed, the select may block
4760 displaying a trashed screen. */
4761 if (frame_garbaged
&& do_display
)
4763 clear_waiting_for_input ();
4764 redisplay_preserve_echo_area (11);
4766 set_waiting_for_input (&timeout
);
4770 if (read_kbd
&& detect_input_pending ())
4777 #ifdef NON_BLOCKING_CONNECT
4779 Connecting
= connect_wait_mask
;
4782 #ifdef ADAPTIVE_READ_BUFFERING
4783 /* Set the timeout for adaptive read buffering if any
4784 process has non-zero read_output_skip and non-zero
4785 read_output_delay, and we are not reading output for a
4786 specific wait_channel. It is not executed if
4787 Vprocess_adaptive_read_buffering is nil. */
4788 if (process_output_skip
&& check_delay
> 0)
4790 int usecs
= EMACS_USECS (timeout
);
4791 if (EMACS_SECS (timeout
) > 0 || usecs
> READ_OUTPUT_DELAY_MAX
)
4792 usecs
= READ_OUTPUT_DELAY_MAX
;
4793 for (channel
= 0; check_delay
> 0 && channel
<= max_process_desc
; channel
++)
4795 proc
= chan_process
[channel
];
4798 /* Find minimum non-zero read_output_delay among the
4799 processes with non-zero read_output_skip. */
4800 if (XPROCESS (proc
)->read_output_delay
> 0)
4803 if (!XPROCESS (proc
)->read_output_skip
)
4805 FD_CLR (channel
, &Available
);
4806 XPROCESS (proc
)->read_output_skip
= 0;
4807 if (XPROCESS (proc
)->read_output_delay
< usecs
)
4808 usecs
= XPROCESS (proc
)->read_output_delay
;
4811 EMACS_SET_SECS_USECS (timeout
, 0, usecs
);
4812 process_output_skip
= 0;
4815 #if defined (USE_GTK) || defined (HAVE_GCONF)
4817 #elif defined (HAVE_NS)
4822 (max (max (max_process_desc
, max_keyboard_desc
),
4825 #ifdef NON_BLOCKING_CONNECT
4826 (check_connect
? &Connecting
: (SELECT_TYPE
*)0),
4830 (SELECT_TYPE
*)0, &timeout
);
4835 /* Make C-g and alarm signals set flags again */
4836 clear_waiting_for_input ();
4838 /* If we woke up due to SIGWINCH, actually change size now. */
4839 do_pending_window_change (0);
4841 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
4842 /* We wanted the full specified time, so return now. */
4846 if (xerrno
== EINTR
)
4848 else if (xerrno
== EBADF
)
4851 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
4852 the child's closure of the pts gives the parent a SIGHUP, and
4853 the ptc file descriptor is automatically closed,
4854 yielding EBADF here or at select() call above.
4855 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
4856 in m/ibmrt-aix.h), and here we just ignore the select error.
4857 Cleanup occurs c/o status_notify after SIGCLD. */
4858 no_avail
= 1; /* Cannot depend on values returned */
4864 error ("select error: %s", emacs_strerror (xerrno
));
4869 FD_ZERO (&Available
);
4870 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4873 #if 0 /* When polling is used, interrupt_input is 0,
4874 so get_input_pending should read the input.
4875 So this should not be needed. */
4876 /* If we are using polling for input,
4877 and we see input available, make it get read now.
4878 Otherwise it might not actually get read for a second.
4879 And on hpux, since we turn off polling in wait_reading_process_output,
4880 it might never get read at all if we don't spend much time
4881 outside of wait_reading_process_output. */
4882 if (read_kbd
&& interrupt_input
4883 && keyboard_bit_set (&Available
)
4884 && input_polling_used ())
4885 kill (getpid (), SIGALRM
);
4888 /* Check for keyboard input */
4889 /* If there is any, return immediately
4890 to give it higher priority than subprocesses */
4894 int old_timers_run
= timers_run
;
4895 struct buffer
*old_buffer
= current_buffer
;
4896 Lisp_Object old_window
= selected_window
;
4899 if (detect_input_pending_run_timers (do_display
))
4901 swallow_events (do_display
);
4902 if (detect_input_pending_run_timers (do_display
))
4906 /* If a timer has run, this might have changed buffers
4907 an alike. Make read_key_sequence aware of that. */
4908 if (timers_run
!= old_timers_run
4909 && waiting_for_user_input_p
== -1
4910 && (old_buffer
!= current_buffer
4911 || !EQ (old_window
, selected_window
)))
4912 record_asynch_buffer_change ();
4918 /* If there is unread keyboard input, also return. */
4920 && requeued_events_pending_p ())
4923 /* If we are not checking for keyboard input now,
4924 do process events (but don't run any timers).
4925 This is so that X events will be processed.
4926 Otherwise they may have to wait until polling takes place.
4927 That would causes delays in pasting selections, for example.
4929 (We used to do this only if wait_for_cell.) */
4930 if (read_kbd
== 0 && detect_input_pending ())
4932 swallow_events (do_display
);
4933 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
4934 if (detect_input_pending ())
4939 /* Exit now if the cell we're waiting for became non-nil. */
4940 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4944 /* If we think we have keyboard input waiting, but didn't get SIGIO,
4945 go read it. This can happen with X on BSD after logging out.
4946 In that case, there really is no input and no SIGIO,
4947 but select says there is input. */
4949 if (read_kbd
&& interrupt_input
4950 && keyboard_bit_set (&Available
) && ! noninteractive
)
4951 kill (getpid (), SIGIO
);
4955 got_some_input
|= nfds
> 0;
4957 /* If checking input just got us a size-change event from X,
4958 obey it now if we should. */
4959 if (read_kbd
|| ! NILP (wait_for_cell
))
4960 do_pending_window_change (0);
4962 /* Check for data from a process. */
4963 if (no_avail
|| nfds
== 0)
4966 /* Really FIRST_PROC_DESC should be 0 on Unix,
4967 but this is safer in the short run. */
4968 for (channel
= 0; channel
<= max_process_desc
; channel
++)
4970 if (FD_ISSET (channel
, &Available
)
4971 && FD_ISSET (channel
, &non_keyboard_wait_mask
))
4975 /* If waiting for this channel, arrange to return as
4976 soon as no more input to be processed. No more
4978 if (wait_channel
== channel
)
4984 proc
= chan_process
[channel
];
4988 /* If this is a server stream socket, accept connection. */
4989 if (EQ (XPROCESS (proc
)->status
, Qlisten
))
4991 server_accept_connection (proc
, channel
);
4995 /* Read data from the process, starting with our
4996 buffered-ahead character if we have one. */
4998 nread
= read_process_output (proc
, channel
);
5001 /* Since read_process_output can run a filter,
5002 which can call accept-process-output,
5003 don't try to read from any other processes
5004 before doing the select again. */
5005 FD_ZERO (&Available
);
5008 redisplay_preserve_echo_area (12);
5011 else if (nread
== -1 && errno
== EWOULDBLOCK
)
5014 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
5015 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
5017 else if (nread
== -1 && errno
== EAGAIN
)
5021 else if (nread
== -1 && errno
== EAGAIN
)
5023 /* Note that we cannot distinguish between no input
5024 available now and a closed pipe.
5025 With luck, a closed pipe will be accompanied by
5026 subprocess termination and SIGCHLD. */
5027 else if (nread
== 0 && !NETCONN_P (proc
) && !SERIALCONN_P (proc
))
5029 #endif /* O_NDELAY */
5030 #endif /* O_NONBLOCK */
5032 /* On some OSs with ptys, when the process on one end of
5033 a pty exits, the other end gets an error reading with
5034 errno = EIO instead of getting an EOF (0 bytes read).
5035 Therefore, if we get an error reading and errno =
5036 EIO, just continue, because the child process has
5037 exited and should clean itself up soon (e.g. when we
5040 However, it has been known to happen that the SIGCHLD
5041 got lost. So raise the signal again just in case.
5043 else if (nread
== -1 && errno
== EIO
)
5045 /* Clear the descriptor now, so we only raise the
5046 signal once. Don't do this if `process' is only
5048 if (XPROCESS (proc
)->pid
!= -2)
5050 FD_CLR (channel
, &input_wait_mask
);
5051 FD_CLR (channel
, &non_keyboard_wait_mask
);
5053 kill (getpid (), SIGCHLD
);
5056 #endif /* HAVE_PTYS */
5057 /* If we can detect process termination, don't consider the process
5058 gone just because its pipe is closed. */
5060 else if (nread
== 0 && !NETCONN_P (proc
) && !SERIALCONN_P (proc
))
5065 /* Preserve status of processes already terminated. */
5066 XPROCESS (proc
)->tick
= ++process_tick
;
5067 deactivate_process (proc
);
5068 if (XPROCESS (proc
)->raw_status_new
)
5069 update_status (XPROCESS (proc
));
5070 if (EQ (XPROCESS (proc
)->status
, Qrun
))
5071 XPROCESS (proc
)->status
5072 = Fcons (Qexit
, Fcons (make_number (256), Qnil
));
5075 #ifdef NON_BLOCKING_CONNECT
5076 if (check_connect
&& FD_ISSET (channel
, &Connecting
)
5077 && FD_ISSET (channel
, &connect_wait_mask
))
5079 struct Lisp_Process
*p
;
5081 FD_CLR (channel
, &connect_wait_mask
);
5082 if (--num_pending_connects
< 0)
5085 proc
= chan_process
[channel
];
5089 p
= XPROCESS (proc
);
5092 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
5093 So only use it on systems where it is known to work. */
5095 int xlen
= sizeof (xerrno
);
5096 if (getsockopt (channel
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &xlen
))
5101 struct sockaddr pname
;
5102 int pnamelen
= sizeof (pname
);
5104 /* If connection failed, getpeername will fail. */
5106 if (getpeername (channel
, &pname
, &pnamelen
) < 0)
5108 /* Obtain connect failure code through error slippage. */
5111 if (errno
== ENOTCONN
&& read (channel
, &dummy
, 1) < 0)
5118 p
->tick
= ++process_tick
;
5119 p
->status
= Fcons (Qfailed
, Fcons (make_number (xerrno
), Qnil
));
5120 deactivate_process (proc
);
5125 /* Execute the sentinel here. If we had relied on
5126 status_notify to do it later, it will read input
5127 from the process before calling the sentinel. */
5128 exec_sentinel (proc
, build_string ("open\n"));
5129 if (!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
5131 FD_SET (p
->infd
, &input_wait_mask
);
5132 FD_SET (p
->infd
, &non_keyboard_wait_mask
);
5136 #endif /* NON_BLOCKING_CONNECT */
5137 } /* end for each file descriptor */
5138 } /* end while exit conditions not met */
5140 unbind_to (count
, Qnil
);
5142 /* If calling from keyboard input, do not quit
5143 since we want to return C-g as an input character.
5144 Otherwise, do pending quit if requested. */
5147 /* Prevent input_pending from remaining set if we quit. */
5148 clear_input_pending ();
5152 return got_some_input
;
5155 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
5158 read_process_output_call (Lisp_Object fun_and_args
)
5160 return apply1 (XCAR (fun_and_args
), XCDR (fun_and_args
));
5164 read_process_output_error_handler (Lisp_Object error
)
5166 cmd_error_internal (error
, "error in process filter: ");
5168 update_echo_area ();
5169 Fsleep_for (make_number (2), Qnil
);
5173 /* Read pending output from the process channel,
5174 starting with our buffered-ahead character if we have one.
5175 Yield number of decoded characters read.
5177 This function reads at most 4096 characters.
5178 If you want to read all available subprocess output,
5179 you must call it repeatedly until it returns zero.
5181 The characters read are decoded according to PROC's coding-system
5185 read_process_output (Lisp_Object proc
, register int channel
)
5187 register int nbytes
;
5189 register Lisp_Object outstream
;
5190 register struct Lisp_Process
*p
= XPROCESS (proc
);
5191 register int opoint
;
5192 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
5193 int carryover
= p
->decoding_carryover
;
5195 int count
= SPECPDL_INDEX ();
5196 Lisp_Object odeactivate
;
5198 chars
= (char *) alloca (carryover
+ readmax
);
5200 /* See the comment above. */
5201 memcpy (chars
, SDATA (p
->decoding_buf
), carryover
);
5203 #ifdef DATAGRAM_SOCKETS
5204 /* We have a working select, so proc_buffered_char is always -1. */
5205 if (DATAGRAM_CHAN_P (channel
))
5207 int len
= datagram_address
[channel
].len
;
5208 nbytes
= recvfrom (channel
, chars
+ carryover
, readmax
,
5209 0, datagram_address
[channel
].sa
, &len
);
5213 if (proc_buffered_char
[channel
] < 0)
5215 nbytes
= emacs_read (channel
, chars
+ carryover
, readmax
);
5216 #ifdef ADAPTIVE_READ_BUFFERING
5217 if (nbytes
> 0 && p
->adaptive_read_buffering
)
5219 int delay
= p
->read_output_delay
;
5222 if (delay
< READ_OUTPUT_DELAY_MAX_MAX
)
5225 process_output_delay_count
++;
5226 delay
+= READ_OUTPUT_DELAY_INCREMENT
* 2;
5229 else if (delay
> 0 && (nbytes
== readmax
))
5231 delay
-= READ_OUTPUT_DELAY_INCREMENT
;
5233 process_output_delay_count
--;
5235 p
->read_output_delay
= delay
;
5238 p
->read_output_skip
= 1;
5239 process_output_skip
= 1;
5246 chars
[carryover
] = proc_buffered_char
[channel
];
5247 proc_buffered_char
[channel
] = -1;
5248 nbytes
= emacs_read (channel
, chars
+ carryover
+ 1, readmax
- 1);
5252 nbytes
= nbytes
+ 1;
5255 p
->decoding_carryover
= 0;
5257 /* At this point, NBYTES holds number of bytes just received
5258 (including the one in proc_buffered_char[channel]). */
5261 if (nbytes
< 0 || coding
->mode
& CODING_MODE_LAST_BLOCK
)
5263 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5266 /* Now set NBYTES how many bytes we must decode. */
5267 nbytes
+= carryover
;
5269 odeactivate
= Vdeactivate_mark
;
5270 /* There's no good reason to let process filters change the current
5271 buffer, and many callers of accept-process-output, sit-for, and
5272 friends don't expect current-buffer to be changed from under them. */
5273 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
5275 /* Read and dispose of the process output. */
5276 outstream
= p
->filter
;
5277 if (!NILP (outstream
))
5279 Lisp_Object obuffer
, okeymap
;
5281 int outer_running_asynch_code
= running_asynch_code
;
5282 int waiting
= waiting_for_user_input_p
;
5284 /* No need to gcpro these, because all we do with them later
5285 is test them for EQness, and none of them should be a string. */
5286 XSETBUFFER (obuffer
, current_buffer
);
5287 okeymap
= current_buffer
->keymap
;
5289 /* We inhibit quit here instead of just catching it so that
5290 hitting ^G when a filter happens to be running won't screw
5292 specbind (Qinhibit_quit
, Qt
);
5293 specbind (Qlast_nonmenu_event
, Qt
);
5295 /* In case we get recursively called,
5296 and we already saved the match data nonrecursively,
5297 save the same match data in safely recursive fashion. */
5298 if (outer_running_asynch_code
)
5301 /* Don't clobber the CURRENT match data, either! */
5302 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
5303 restore_search_regs ();
5304 record_unwind_save_match_data ();
5305 Fset_match_data (tem
, Qt
);
5308 /* For speed, if a search happens within this code,
5309 save the match data in a special nonrecursive fashion. */
5310 running_asynch_code
= 1;
5312 decode_coding_c_string (coding
, chars
, nbytes
, Qt
);
5313 text
= coding
->dst_object
;
5314 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5315 /* A new coding system might be found. */
5316 if (!EQ (p
->decode_coding_system
, Vlast_coding_system_used
))
5318 p
->decode_coding_system
= Vlast_coding_system_used
;
5320 /* Don't call setup_coding_system for
5321 proc_decode_coding_system[channel] here. It is done in
5322 detect_coding called via decode_coding above. */
5324 /* If a coding system for encoding is not yet decided, we set
5325 it as the same as coding-system for decoding.
5327 But, before doing that we must check if
5328 proc_encode_coding_system[p->outfd] surely points to a
5329 valid memory because p->outfd will be changed once EOF is
5330 sent to the process. */
5331 if (NILP (p
->encode_coding_system
)
5332 && proc_encode_coding_system
[p
->outfd
])
5334 p
->encode_coding_system
5335 = coding_inherit_eol_type (Vlast_coding_system_used
, Qnil
);
5336 setup_coding_system (p
->encode_coding_system
,
5337 proc_encode_coding_system
[p
->outfd
]);
5341 if (coding
->carryover_bytes
> 0)
5343 if (SCHARS (p
->decoding_buf
) < coding
->carryover_bytes
)
5344 p
->decoding_buf
= make_uninit_string (coding
->carryover_bytes
);
5345 memcpy (SDATA (p
->decoding_buf
), coding
->carryover
,
5346 coding
->carryover_bytes
);
5347 p
->decoding_carryover
= coding
->carryover_bytes
;
5349 if (SBYTES (text
) > 0)
5350 internal_condition_case_1 (read_process_output_call
,
5352 Fcons (proc
, Fcons (text
, Qnil
))),
5353 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
5354 read_process_output_error_handler
);
5356 /* If we saved the match data nonrecursively, restore it now. */
5357 restore_search_regs ();
5358 running_asynch_code
= outer_running_asynch_code
;
5360 /* Restore waiting_for_user_input_p as it was
5361 when we were called, in case the filter clobbered it. */
5362 waiting_for_user_input_p
= waiting
;
5364 #if 0 /* Call record_asynch_buffer_change unconditionally,
5365 because we might have changed minor modes or other things
5366 that affect key bindings. */
5367 if (! EQ (Fcurrent_buffer (), obuffer
)
5368 || ! EQ (current_buffer
->keymap
, okeymap
))
5370 /* But do it only if the caller is actually going to read events.
5371 Otherwise there's no need to make him wake up, and it could
5372 cause trouble (for example it would make sit_for return). */
5373 if (waiting_for_user_input_p
== -1)
5374 record_asynch_buffer_change ();
5377 /* If no filter, write into buffer if it isn't dead. */
5378 else if (!NILP (p
->buffer
) && !NILP (XBUFFER (p
->buffer
)->name
))
5380 Lisp_Object old_read_only
;
5381 int old_begv
, old_zv
;
5382 int old_begv_byte
, old_zv_byte
;
5383 int before
, before_byte
;
5388 Fset_buffer (p
->buffer
);
5390 opoint_byte
= PT_BYTE
;
5391 old_read_only
= current_buffer
->read_only
;
5394 old_begv_byte
= BEGV_BYTE
;
5395 old_zv_byte
= ZV_BYTE
;
5397 current_buffer
->read_only
= Qnil
;
5399 /* Insert new output into buffer
5400 at the current end-of-output marker,
5401 thus preserving logical ordering of input and output. */
5402 if (XMARKER (p
->mark
)->buffer
)
5403 SET_PT_BOTH (clip_to_bounds (BEGV
, marker_position (p
->mark
), ZV
),
5404 clip_to_bounds (BEGV_BYTE
, marker_byte_position (p
->mark
),
5407 SET_PT_BOTH (ZV
, ZV_BYTE
);
5409 before_byte
= PT_BYTE
;
5411 /* If the output marker is outside of the visible region, save
5412 the restriction and widen. */
5413 if (! (BEGV
<= PT
&& PT
<= ZV
))
5416 decode_coding_c_string (coding
, chars
, nbytes
, Qt
);
5417 text
= coding
->dst_object
;
5418 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5419 /* A new coding system might be found. See the comment in the
5420 similar code in the previous `if' block. */
5421 if (!EQ (p
->decode_coding_system
, Vlast_coding_system_used
))
5423 p
->decode_coding_system
= Vlast_coding_system_used
;
5424 if (NILP (p
->encode_coding_system
)
5425 && proc_encode_coding_system
[p
->outfd
])
5427 p
->encode_coding_system
5428 = coding_inherit_eol_type (Vlast_coding_system_used
, Qnil
);
5429 setup_coding_system (p
->encode_coding_system
,
5430 proc_encode_coding_system
[p
->outfd
]);
5433 if (coding
->carryover_bytes
> 0)
5435 if (SCHARS (p
->decoding_buf
) < coding
->carryover_bytes
)
5436 p
->decoding_buf
= make_uninit_string (coding
->carryover_bytes
);
5437 memcpy (SDATA (p
->decoding_buf
), coding
->carryover
,
5438 coding
->carryover_bytes
);
5439 p
->decoding_carryover
= coding
->carryover_bytes
;
5441 /* Adjust the multibyteness of TEXT to that of the buffer. */
5442 if (NILP (current_buffer
->enable_multibyte_characters
)
5443 != ! STRING_MULTIBYTE (text
))
5444 text
= (STRING_MULTIBYTE (text
)
5445 ? Fstring_as_unibyte (text
)
5446 : Fstring_to_multibyte (text
));
5447 /* Insert before markers in case we are inserting where
5448 the buffer's mark is, and the user's next command is Meta-y. */
5449 insert_from_string_before_markers (text
, 0, 0,
5450 SCHARS (text
), SBYTES (text
), 0);
5452 /* Make sure the process marker's position is valid when the
5453 process buffer is changed in the signal_after_change above.
5454 W3 is known to do that. */
5455 if (BUFFERP (p
->buffer
)
5456 && (b
= XBUFFER (p
->buffer
), b
!= current_buffer
))
5457 set_marker_both (p
->mark
, p
->buffer
, BUF_PT (b
), BUF_PT_BYTE (b
));
5459 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
5461 update_mode_lines
++;
5463 /* Make sure opoint and the old restrictions
5464 float ahead of any new text just as point would. */
5465 if (opoint
>= before
)
5467 opoint
+= PT
- before
;
5468 opoint_byte
+= PT_BYTE
- before_byte
;
5470 if (old_begv
> before
)
5472 old_begv
+= PT
- before
;
5473 old_begv_byte
+= PT_BYTE
- before_byte
;
5475 if (old_zv
>= before
)
5477 old_zv
+= PT
- before
;
5478 old_zv_byte
+= PT_BYTE
- before_byte
;
5481 /* If the restriction isn't what it should be, set it. */
5482 if (old_begv
!= BEGV
|| old_zv
!= ZV
)
5483 Fnarrow_to_region (make_number (old_begv
), make_number (old_zv
));
5486 current_buffer
->read_only
= old_read_only
;
5487 SET_PT_BOTH (opoint
, opoint_byte
);
5489 /* Handling the process output should not deactivate the mark. */
5490 Vdeactivate_mark
= odeactivate
;
5492 unbind_to (count
, Qnil
);
5496 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
, Swaiting_for_user_input_p
,
5498 doc
: /* Returns non-nil if Emacs is waiting for input from the user.
5499 This is intended for use by asynchronous process output filters and sentinels. */)
5502 return (waiting_for_user_input_p
? Qt
: Qnil
);
5505 /* Sending data to subprocess */
5507 jmp_buf send_process_frame
;
5508 Lisp_Object process_sent_to
;
5511 send_process_trap (int ignore
)
5513 SIGNAL_THREAD_CHECK (SIGPIPE
);
5514 sigunblock (sigmask (SIGPIPE
));
5515 longjmp (send_process_frame
, 1);
5518 /* Send some data to process PROC.
5519 BUF is the beginning of the data; LEN is the number of characters.
5520 OBJECT is the Lisp object that the data comes from. If OBJECT is
5521 nil or t, it means that the data comes from C string.
5523 If OBJECT is not nil, the data is encoded by PROC's coding-system
5524 for encoding before it is sent.
5526 This function can evaluate Lisp code and can garbage collect. */
5529 send_process (volatile Lisp_Object proc
, unsigned char *volatile buf
,
5530 volatile int len
, volatile Lisp_Object object
)
5532 /* Use volatile to protect variables from being clobbered by longjmp. */
5533 struct Lisp_Process
*p
= XPROCESS (proc
);
5535 struct coding_system
*coding
;
5536 struct gcpro gcpro1
;
5537 SIGTYPE (*volatile old_sigpipe
) (int);
5541 if (p
->raw_status_new
)
5543 if (! EQ (p
->status
, Qrun
))
5544 error ("Process %s not running", SDATA (p
->name
));
5546 error ("Output file descriptor of %s is closed", SDATA (p
->name
));
5548 coding
= proc_encode_coding_system
[p
->outfd
];
5549 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5551 if ((STRINGP (object
) && STRING_MULTIBYTE (object
))
5552 || (BUFFERP (object
)
5553 && !NILP (XBUFFER (object
)->enable_multibyte_characters
))
5556 if (!EQ (Vlast_coding_system_used
, p
->encode_coding_system
))
5557 /* The coding system for encoding was changed to raw-text
5558 because we sent a unibyte text previously. Now we are
5559 sending a multibyte text, thus we must encode it by the
5560 original coding system specified for the current process. */
5561 setup_coding_system (p
->encode_coding_system
, coding
);
5562 coding
->src_multibyte
= 1;
5566 /* For sending a unibyte text, character code conversion should
5567 not take place but EOL conversion should. So, setup raw-text
5568 or one of the subsidiary if we have not yet done it. */
5569 if (CODING_REQUIRE_ENCODING (coding
))
5571 if (CODING_REQUIRE_FLUSHING (coding
))
5573 /* But, before changing the coding, we must flush out data. */
5574 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5575 send_process (proc
, "", 0, Qt
);
5576 coding
->mode
&= CODING_MODE_LAST_BLOCK
;
5578 setup_coding_system (raw_text_coding_system
5579 (Vlast_coding_system_used
),
5581 coding
->src_multibyte
= 0;
5584 coding
->dst_multibyte
= 0;
5586 if (CODING_REQUIRE_ENCODING (coding
))
5588 coding
->dst_object
= Qt
;
5589 if (BUFFERP (object
))
5591 int from_byte
, from
, to
;
5592 int save_pt
, save_pt_byte
;
5593 struct buffer
*cur
= current_buffer
;
5595 set_buffer_internal (XBUFFER (object
));
5596 save_pt
= PT
, save_pt_byte
= PT_BYTE
;
5598 from_byte
= PTR_BYTE_POS (buf
);
5599 from
= BYTE_TO_CHAR (from_byte
);
5600 to
= BYTE_TO_CHAR (from_byte
+ len
);
5601 TEMP_SET_PT_BOTH (from
, from_byte
);
5602 encode_coding_object (coding
, object
, from
, from_byte
,
5603 to
, from_byte
+ len
, Qt
);
5604 TEMP_SET_PT_BOTH (save_pt
, save_pt_byte
);
5605 set_buffer_internal (cur
);
5607 else if (STRINGP (object
))
5609 encode_coding_object (coding
, object
, 0, 0, SCHARS (object
),
5610 SBYTES (object
), Qt
);
5614 coding
->dst_object
= make_unibyte_string (buf
, len
);
5615 coding
->produced
= len
;
5618 len
= coding
->produced
;
5619 object
= coding
->dst_object
;
5620 buf
= SDATA (object
);
5623 if (pty_max_bytes
== 0)
5625 #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
5626 pty_max_bytes
= fpathconf (p
->outfd
, _PC_MAX_CANON
);
5627 if (pty_max_bytes
< 0)
5628 pty_max_bytes
= 250;
5630 pty_max_bytes
= 250;
5632 /* Deduct one, to leave space for the eof. */
5636 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
5637 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
5638 when returning with longjmp despite being declared volatile. */
5639 if (!setjmp (send_process_frame
))
5641 process_sent_to
= proc
;
5646 /* Send this batch, using one or more write calls. */
5649 int outfd
= p
->outfd
;
5650 old_sigpipe
= (SIGTYPE (*) (int)) signal (SIGPIPE
, send_process_trap
);
5651 #ifdef DATAGRAM_SOCKETS
5652 if (DATAGRAM_CHAN_P (outfd
))
5654 rv
= sendto (outfd
, (char *) buf
, this,
5655 0, datagram_address
[outfd
].sa
,
5656 datagram_address
[outfd
].len
);
5657 if (rv
< 0 && errno
== EMSGSIZE
)
5659 signal (SIGPIPE
, old_sigpipe
);
5660 report_file_error ("sending datagram",
5661 Fcons (proc
, Qnil
));
5667 rv
= emacs_write (outfd
, (char *) buf
, this);
5668 #ifdef ADAPTIVE_READ_BUFFERING
5669 if (p
->read_output_delay
> 0
5670 && p
->adaptive_read_buffering
== 1)
5672 p
->read_output_delay
= 0;
5673 process_output_delay_count
--;
5674 p
->read_output_skip
= 0;
5678 signal (SIGPIPE
, old_sigpipe
);
5684 || errno
== EWOULDBLOCK
5690 /* Buffer is full. Wait, accepting input;
5691 that may allow the program
5692 to finish doing output and read more. */
5696 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
5697 /* A gross hack to work around a bug in FreeBSD.
5698 In the following sequence, read(2) returns
5702 write(2) 954 bytes, get EAGAIN
5703 read(2) 1024 bytes in process_read_output
5704 read(2) 11 bytes in process_read_output
5706 That is, read(2) returns more bytes than have
5707 ever been written successfully. The 1033 bytes
5708 read are the 1022 bytes written successfully
5709 after processing (for example with CRs added if
5710 the terminal is set up that way which it is
5711 here). The same bytes will be seen again in a
5712 later read(2), without the CRs. */
5714 if (errno
== EAGAIN
)
5717 ioctl (p
->outfd
, TIOCFLUSH
, &flags
);
5719 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
5721 /* Running filters might relocate buffers or strings.
5722 Arrange to relocate BUF. */
5723 if (BUFFERP (object
))
5724 offset
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
5725 else if (STRINGP (object
))
5726 offset
= buf
- SDATA (object
);
5728 #ifdef EMACS_HAS_USECS
5729 wait_reading_process_output (0, 20000, 0, 0, Qnil
, NULL
, 0);
5731 wait_reading_process_output (1, 0, 0, 0, Qnil
, NULL
, 0);
5734 if (BUFFERP (object
))
5735 buf
= BUF_BYTE_ADDRESS (XBUFFER (object
), offset
);
5736 else if (STRINGP (object
))
5737 buf
= offset
+ SDATA (object
);
5742 /* This is a real error. */
5743 report_file_error ("writing to process", Fcons (proc
, Qnil
));
5753 signal (SIGPIPE
, old_sigpipe
);
5754 proc
= process_sent_to
;
5755 p
= XPROCESS (proc
);
5756 p
->raw_status_new
= 0;
5757 p
->status
= Fcons (Qexit
, Fcons (make_number (256), Qnil
));
5758 p
->tick
= ++process_tick
;
5759 deactivate_process (proc
);
5760 error ("SIGPIPE raised on process %s; closed it", SDATA (p
->name
));
5766 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
5768 doc
: /* Send current contents of region as input to PROCESS.
5769 PROCESS may be a process, a buffer, the name of a process or buffer, or
5770 nil, indicating the current buffer's process.
5771 Called from program, takes three arguments, PROCESS, START and END.
5772 If the region is more than 500 characters long,
5773 it is sent in several bunches. This may happen even for shorter regions.
5774 Output from processes can arrive in between bunches. */)
5775 (Lisp_Object process
, Lisp_Object start
, Lisp_Object end
)
5780 proc
= get_process (process
);
5781 validate_region (&start
, &end
);
5783 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
5784 move_gap (XINT (start
));
5786 start1
= CHAR_TO_BYTE (XINT (start
));
5787 end1
= CHAR_TO_BYTE (XINT (end
));
5788 send_process (proc
, BYTE_POS_ADDR (start1
), end1
- start1
,
5789 Fcurrent_buffer ());
5794 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
5796 doc
: /* Send PROCESS the contents of STRING as input.
5797 PROCESS may be a process, a buffer, the name of a process or buffer, or
5798 nil, indicating the current buffer's process.
5799 If STRING is more than 500 characters long,
5800 it is sent in several bunches. This may happen even for shorter strings.
5801 Output from processes can arrive in between bunches. */)
5802 (Lisp_Object process
, Lisp_Object string
)
5805 CHECK_STRING (string
);
5806 proc
= get_process (process
);
5807 send_process (proc
, SDATA (string
),
5808 SBYTES (string
), string
);
5812 /* Return the foreground process group for the tty/pty that
5813 the process P uses. */
5815 emacs_get_tty_pgrp (struct Lisp_Process
*p
)
5820 if (ioctl (p
->infd
, TIOCGPGRP
, &gid
) == -1 && ! NILP (p
->tty_name
))
5823 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
5824 master side. Try the slave side. */
5825 fd
= emacs_open (SDATA (p
->tty_name
), O_RDONLY
, 0);
5829 ioctl (fd
, TIOCGPGRP
, &gid
);
5833 #endif /* defined (TIOCGPGRP ) */
5838 DEFUN ("process-running-child-p", Fprocess_running_child_p
,
5839 Sprocess_running_child_p
, 0, 1, 0,
5840 doc
: /* Return t if PROCESS has given the terminal to a child.
5841 If the operating system does not make it possible to find out,
5842 return t unconditionally. */)
5843 (Lisp_Object process
)
5845 /* Initialize in case ioctl doesn't exist or gives an error,
5846 in a way that will cause returning t. */
5849 struct Lisp_Process
*p
;
5851 proc
= get_process (process
);
5852 p
= XPROCESS (proc
);
5854 if (!EQ (p
->type
, Qreal
))
5855 error ("Process %s is not a subprocess",
5858 error ("Process %s is not active",
5861 gid
= emacs_get_tty_pgrp (p
);
5868 /* send a signal number SIGNO to PROCESS.
5869 If CURRENT_GROUP is t, that means send to the process group
5870 that currently owns the terminal being used to communicate with PROCESS.
5871 This is used for various commands in shell mode.
5872 If CURRENT_GROUP is lambda, that means send to the process group
5873 that currently owns the terminal, but only if it is NOT the shell itself.
5875 If NOMSG is zero, insert signal-announcements into process's buffers
5878 If we can, we try to signal PROCESS by sending control characters
5879 down the pty. This allows us to signal inferiors who have changed
5880 their uid, for which killpg would return an EPERM error. */
5883 process_send_signal (Lisp_Object process
, int signo
, Lisp_Object current_group
,
5887 register struct Lisp_Process
*p
;
5891 proc
= get_process (process
);
5892 p
= XPROCESS (proc
);
5894 if (!EQ (p
->type
, Qreal
))
5895 error ("Process %s is not a subprocess",
5898 error ("Process %s is not active",
5902 current_group
= Qnil
;
5904 /* If we are using pgrps, get a pgrp number and make it negative. */
5905 if (NILP (current_group
))
5906 /* Send the signal to the shell's process group. */
5910 #ifdef SIGNALS_VIA_CHARACTERS
5911 /* If possible, send signals to the entire pgrp
5912 by sending an input character to it. */
5914 /* TERMIOS is the latest and bestest, and seems most likely to
5915 work. If the system has it, use it. */
5918 cc_t
*sig_char
= NULL
;
5920 tcgetattr (p
->infd
, &t
);
5925 sig_char
= &t
.c_cc
[VINTR
];
5929 sig_char
= &t
.c_cc
[VQUIT
];
5933 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
5934 sig_char
= &t
.c_cc
[VSWTCH
];
5936 sig_char
= &t
.c_cc
[VSUSP
];
5941 if (sig_char
&& *sig_char
!= CDISABLE
)
5943 send_process (proc
, sig_char
, 1, Qnil
);
5946 /* If we can't send the signal with a character,
5947 fall through and send it another way. */
5948 #else /* ! HAVE_TERMIOS */
5950 /* On Berkeley descendants, the following IOCTL's retrieve the
5951 current control characters. */
5952 #if defined (TIOCGLTC) && defined (TIOCGETC)
5960 ioctl (p
->infd
, TIOCGETC
, &c
);
5961 send_process (proc
, &c
.t_intrc
, 1, Qnil
);
5964 ioctl (p
->infd
, TIOCGETC
, &c
);
5965 send_process (proc
, &c
.t_quitc
, 1, Qnil
);
5969 ioctl (p
->infd
, TIOCGLTC
, &lc
);
5970 send_process (proc
, &lc
.t_suspc
, 1, Qnil
);
5972 #endif /* ! defined (SIGTSTP) */
5975 #else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5977 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
5984 ioctl (p
->infd
, TCGETA
, &t
);
5985 send_process (proc
, &t
.c_cc
[VINTR
], 1, Qnil
);
5988 ioctl (p
->infd
, TCGETA
, &t
);
5989 send_process (proc
, &t
.c_cc
[VQUIT
], 1, Qnil
);
5993 ioctl (p
->infd
, TCGETA
, &t
);
5994 send_process (proc
, &t
.c_cc
[VSWTCH
], 1, Qnil
);
5996 #endif /* ! defined (SIGTSTP) */
5998 #else /* ! defined (TCGETA) */
5999 Your configuration files are messed up
.
6000 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
6001 you'd better be using one of the alternatives above! */
6002 #endif /* ! defined (TCGETA) */
6003 #endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
6004 /* In this case, the code above should alway return. */
6006 #endif /* ! defined HAVE_TERMIOS */
6008 /* The code above may fall through if it can't
6009 handle the signal. */
6010 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
6013 /* Get the current pgrp using the tty itself, if we have that.
6014 Otherwise, use the pty to get the pgrp.
6015 On pfa systems, saka@pfu.fujitsu.co.JP writes:
6016 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
6017 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
6018 His patch indicates that if TIOCGPGRP returns an error, then
6019 we should just assume that p->pid is also the process group id. */
6021 gid
= emacs_get_tty_pgrp (p
);
6024 /* If we can't get the information, assume
6025 the shell owns the tty. */
6028 /* It is not clear whether anything really can set GID to -1.
6029 Perhaps on some system one of those ioctls can or could do so.
6030 Or perhaps this is vestigial. */
6033 #else /* ! defined (TIOCGPGRP ) */
6034 /* Can't select pgrps on this system, so we know that
6035 the child itself heads the pgrp. */
6037 #endif /* ! defined (TIOCGPGRP ) */
6039 /* If current_group is lambda, and the shell owns the terminal,
6040 don't send any signal. */
6041 if (EQ (current_group
, Qlambda
) && gid
== p
->pid
)
6049 p
->raw_status_new
= 0;
6051 p
->tick
= ++process_tick
;
6054 status_notify (NULL
);
6055 redisplay_preserve_echo_area (13);
6058 #endif /* ! defined (SIGCONT) */
6062 flush_pending_output (p
->infd
);
6066 /* If we don't have process groups, send the signal to the immediate
6067 subprocess. That isn't really right, but it's better than any
6068 obvious alternative. */
6071 kill (p
->pid
, signo
);
6075 /* gid may be a pid, or minus a pgrp's number */
6077 if (!NILP (current_group
))
6079 if (ioctl (p
->infd
, TIOCSIGSEND
, signo
) == -1)
6080 EMACS_KILLPG (gid
, signo
);
6087 #else /* ! defined (TIOCSIGSEND) */
6088 EMACS_KILLPG (gid
, signo
);
6089 #endif /* ! defined (TIOCSIGSEND) */
6092 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
6093 doc
: /* Interrupt process PROCESS.
6094 PROCESS may be a process, a buffer, or the name of a process or buffer.
6095 No arg or nil means current buffer's process.
6096 Second arg CURRENT-GROUP non-nil means send signal to
6097 the current process-group of the process's controlling terminal
6098 rather than to the process's own process group.
6099 If the process is a shell, this means interrupt current subjob
6100 rather than the shell.
6102 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
6103 don't send the signal. */)
6104 (Lisp_Object process
, Lisp_Object current_group
)
6106 process_send_signal (process
, SIGINT
, current_group
, 0);
6110 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
6111 doc
: /* Kill process PROCESS. May be process or name of one.
6112 See function `interrupt-process' for more details on usage. */)
6113 (Lisp_Object process
, Lisp_Object current_group
)
6115 process_send_signal (process
, SIGKILL
, current_group
, 0);
6119 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
6120 doc
: /* Send QUIT signal to process PROCESS. May be process or name of one.
6121 See function `interrupt-process' for more details on usage. */)
6122 (Lisp_Object process
, Lisp_Object current_group
)
6124 process_send_signal (process
, SIGQUIT
, current_group
, 0);
6128 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
6129 doc
: /* Stop process PROCESS. May be process or name of one.
6130 See function `interrupt-process' for more details on usage.
6131 If PROCESS is a network or serial process, inhibit handling of incoming
6133 (Lisp_Object process
, Lisp_Object current_group
)
6136 if (PROCESSP (process
) && (NETCONN_P (process
) || SERIALCONN_P (process
)))
6138 struct Lisp_Process
*p
;
6140 p
= XPROCESS (process
);
6141 if (NILP (p
->command
)
6144 FD_CLR (p
->infd
, &input_wait_mask
);
6145 FD_CLR (p
->infd
, &non_keyboard_wait_mask
);
6152 error ("No SIGTSTP support");
6154 process_send_signal (process
, SIGTSTP
, current_group
, 0);
6159 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
6160 doc
: /* Continue process PROCESS. May be process or name of one.
6161 See function `interrupt-process' for more details on usage.
6162 If PROCESS is a network or serial process, resume handling of incoming
6164 (Lisp_Object process
, Lisp_Object current_group
)
6167 if (PROCESSP (process
) && (NETCONN_P (process
) || SERIALCONN_P (process
)))
6169 struct Lisp_Process
*p
;
6171 p
= XPROCESS (process
);
6172 if (EQ (p
->command
, Qt
)
6174 && (!EQ (p
->filter
, Qt
) || EQ (p
->status
, Qlisten
)))
6176 FD_SET (p
->infd
, &input_wait_mask
);
6177 FD_SET (p
->infd
, &non_keyboard_wait_mask
);
6179 if (fd_info
[ p
->infd
].flags
& FILE_SERIAL
)
6180 PurgeComm (fd_info
[ p
->infd
].hnd
, PURGE_RXABORT
| PURGE_RXCLEAR
);
6183 tcflush (p
->infd
, TCIFLUSH
);
6191 process_send_signal (process
, SIGCONT
, current_group
, 0);
6193 error ("No SIGCONT support");
6198 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
6199 2, 2, "sProcess (name or number): \nnSignal code: ",
6200 doc
: /* Send PROCESS the signal with code SIGCODE.
6201 PROCESS may also be a number specifying the process id of the
6202 process to signal; in this case, the process need not be a child of
6204 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
6205 (Lisp_Object process
, Lisp_Object sigcode
)
6209 if (INTEGERP (process
))
6211 pid
= XINT (process
);
6215 if (FLOATP (process
))
6217 pid
= (pid_t
) XFLOAT_DATA (process
);
6221 if (STRINGP (process
))
6224 if (tem
= Fget_process (process
), NILP (tem
))
6226 pid
= XINT (Fstring_to_number (process
, make_number (10)));
6233 process
= get_process (process
);
6238 CHECK_PROCESS (process
);
6239 pid
= XPROCESS (process
)->pid
;
6241 error ("Cannot signal process %s", SDATA (XPROCESS (process
)->name
));
6245 #define parse_signal(NAME, VALUE) \
6246 else if (!xstrcasecmp (name, NAME)) \
6247 XSETINT (sigcode, VALUE)
6249 if (INTEGERP (sigcode
))
6253 unsigned char *name
;
6255 CHECK_SYMBOL (sigcode
);
6256 name
= SDATA (SYMBOL_NAME (sigcode
));
6258 if (!strncmp (name
, "SIG", 3) || !strncmp (name
, "sig", 3))
6264 parse_signal ("usr1", SIGUSR1
);
6267 parse_signal ("usr2", SIGUSR2
);
6270 parse_signal ("term", SIGTERM
);
6273 parse_signal ("hup", SIGHUP
);
6276 parse_signal ("int", SIGINT
);
6279 parse_signal ("quit", SIGQUIT
);
6282 parse_signal ("ill", SIGILL
);
6285 parse_signal ("abrt", SIGABRT
);
6288 parse_signal ("emt", SIGEMT
);
6291 parse_signal ("kill", SIGKILL
);
6294 parse_signal ("fpe", SIGFPE
);
6297 parse_signal ("bus", SIGBUS
);
6300 parse_signal ("segv", SIGSEGV
);
6303 parse_signal ("sys", SIGSYS
);
6306 parse_signal ("pipe", SIGPIPE
);
6309 parse_signal ("alrm", SIGALRM
);
6312 parse_signal ("urg", SIGURG
);
6315 parse_signal ("stop", SIGSTOP
);
6318 parse_signal ("tstp", SIGTSTP
);
6321 parse_signal ("cont", SIGCONT
);
6324 parse_signal ("chld", SIGCHLD
);
6327 parse_signal ("ttin", SIGTTIN
);
6330 parse_signal ("ttou", SIGTTOU
);
6333 parse_signal ("io", SIGIO
);
6336 parse_signal ("xcpu", SIGXCPU
);
6339 parse_signal ("xfsz", SIGXFSZ
);
6342 parse_signal ("vtalrm", SIGVTALRM
);
6345 parse_signal ("prof", SIGPROF
);
6348 parse_signal ("winch", SIGWINCH
);
6351 parse_signal ("info", SIGINFO
);
6354 error ("Undefined signal name %s", name
);
6359 return make_number (kill (pid
, XINT (sigcode
)));
6362 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
6363 doc
: /* Make PROCESS see end-of-file in its input.
6364 EOF comes after any text already sent to it.
6365 PROCESS may be a process, a buffer, the name of a process or buffer, or
6366 nil, indicating the current buffer's process.
6367 If PROCESS is a network connection, or is a process communicating
6368 through a pipe (as opposed to a pty), then you cannot send any more
6369 text to PROCESS after you call this function.
6370 If PROCESS is a serial process, wait until all output written to the
6371 process has been transmitted to the serial port. */)
6372 (Lisp_Object process
)
6375 struct coding_system
*coding
;
6377 if (DATAGRAM_CONN_P (process
))
6380 proc
= get_process (process
);
6381 coding
= proc_encode_coding_system
[XPROCESS (proc
)->outfd
];
6383 /* Make sure the process is really alive. */
6384 if (XPROCESS (proc
)->raw_status_new
)
6385 update_status (XPROCESS (proc
));
6386 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
6387 error ("Process %s not running", SDATA (XPROCESS (proc
)->name
));
6389 if (CODING_REQUIRE_FLUSHING (coding
))
6391 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
6392 send_process (proc
, "", 0, Qnil
);
6395 if (XPROCESS (proc
)->pty_flag
)
6396 send_process (proc
, "\004", 1, Qnil
);
6397 else if (EQ (XPROCESS (proc
)->type
, Qserial
))
6400 if (tcdrain (XPROCESS (proc
)->outfd
) != 0)
6401 error ("tcdrain() failed: %s", emacs_strerror (errno
));
6403 /* Do nothing on Windows because writes are blocking. */
6407 int old_outfd
, new_outfd
;
6409 #ifdef HAVE_SHUTDOWN
6410 /* If this is a network connection, or socketpair is used
6411 for communication with the subprocess, call shutdown to cause EOF.
6412 (In some old system, shutdown to socketpair doesn't work.
6413 Then we just can't win.) */
6414 if (EQ (XPROCESS (proc
)->type
, Qnetwork
)
6415 || XPROCESS (proc
)->outfd
== XPROCESS (proc
)->infd
)
6416 shutdown (XPROCESS (proc
)->outfd
, 1);
6417 /* In case of socketpair, outfd == infd, so don't close it. */
6418 if (XPROCESS (proc
)->outfd
!= XPROCESS (proc
)->infd
)
6419 emacs_close (XPROCESS (proc
)->outfd
);
6420 #else /* not HAVE_SHUTDOWN */
6421 emacs_close (XPROCESS (proc
)->outfd
);
6422 #endif /* not HAVE_SHUTDOWN */
6423 new_outfd
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
6426 old_outfd
= XPROCESS (proc
)->outfd
;
6428 if (!proc_encode_coding_system
[new_outfd
])
6429 proc_encode_coding_system
[new_outfd
]
6430 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
6431 memcpy (proc_encode_coding_system
[new_outfd
],
6432 proc_encode_coding_system
[old_outfd
],
6433 sizeof (struct coding_system
));
6434 memset (proc_encode_coding_system
[old_outfd
], 0,
6435 sizeof (struct coding_system
));
6437 XPROCESS (proc
)->outfd
= new_outfd
;
6442 /* On receipt of a signal that a child status has changed, loop asking
6443 about children with changed statuses until the system says there
6446 All we do is change the status; we do not run sentinels or print
6447 notifications. That is saved for the next time keyboard input is
6448 done, in order to avoid timing errors.
6450 ** WARNING: this can be called during garbage collection.
6451 Therefore, it must not be fooled by the presence of mark bits in
6454 ** USG WARNING: Although it is not obvious from the documentation
6455 in signal(2), on a USG system the SIGCLD handler MUST NOT call
6456 signal() before executing at least one wait(), otherwise the
6457 handler will be called again, resulting in an infinite loop. The
6458 relevant portion of the documentation reads "SIGCLD signals will be
6459 queued and the signal-catching function will be continually
6460 reentered until the queue is empty". Invoking signal() causes the
6461 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
6464 ** Malloc WARNING: This should never call malloc either directly or
6465 indirectly; if it does, that is a bug */
6469 sigchld_handler (int signo
)
6471 int old_errno
= errno
;
6473 register struct Lisp_Process
*p
;
6474 extern EMACS_TIME
*input_available_clear_time
;
6476 SIGNAL_THREAD_CHECK (signo
);
6487 #endif /* no WUNTRACED */
6488 /* Keep trying to get a status until we get a definitive result. */
6492 pid
= wait3 (&w
, WNOHANG
| WUNTRACED
, 0);
6494 while (pid
< 0 && errno
== EINTR
);
6498 /* PID == 0 means no processes found, PID == -1 means a real
6499 failure. We have done all our job, so return. */
6506 #endif /* no WNOHANG */
6508 /* Find the process that signaled us, and record its status. */
6510 /* The process can have been deleted by Fdelete_process. */
6511 for (tail
= deleted_pid_list
; CONSP (tail
); tail
= XCDR (tail
))
6513 Lisp_Object xpid
= XCAR (tail
);
6514 if ((INTEGERP (xpid
) && pid
== (pid_t
) XINT (xpid
))
6515 || (FLOATP (xpid
) && pid
== (pid_t
) XFLOAT_DATA (xpid
)))
6517 XSETCAR (tail
, Qnil
);
6518 goto sigchld_end_of_loop
;
6522 /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
6524 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
6526 proc
= XCDR (XCAR (tail
));
6527 p
= XPROCESS (proc
);
6528 if (EQ (p
->type
, Qreal
) && p
->pid
== pid
)
6533 /* Look for an asynchronous process whose pid hasn't been filled
6536 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
6538 proc
= XCDR (XCAR (tail
));
6539 p
= XPROCESS (proc
);
6545 /* Change the status of the process that was found. */
6548 int clear_desc_flag
= 0;
6550 p
->tick
= ++process_tick
;
6552 p
->raw_status_new
= 1;
6554 /* If process has terminated, stop waiting for its output. */
6555 if ((WIFSIGNALED (w
) || WIFEXITED (w
))
6557 clear_desc_flag
= 1;
6559 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
6560 if (clear_desc_flag
)
6562 FD_CLR (p
->infd
, &input_wait_mask
);
6563 FD_CLR (p
->infd
, &non_keyboard_wait_mask
);
6566 /* Tell wait_reading_process_output that it needs to wake up and
6568 if (input_available_clear_time
)
6569 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6572 /* There was no asynchronous process found for that pid: we have
6573 a synchronous process. */
6576 synch_process_alive
= 0;
6578 /* Report the status of the synchronous process. */
6580 synch_process_retcode
= WRETCODE (w
);
6581 else if (WIFSIGNALED (w
))
6582 synch_process_termsig
= WTERMSIG (w
);
6584 /* Tell wait_reading_process_output that it needs to wake up and
6586 if (input_available_clear_time
)
6587 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6590 sigchld_end_of_loop
:
6593 /* On some systems, we must return right away.
6594 If any more processes want to signal us, we will
6596 Otherwise (on systems that have WNOHANG), loop around
6597 to use up all the processes that have something to tell us. */
6598 #if (defined WINDOWSNT \
6599 || (defined USG && !defined GNU_LINUX \
6600 && !(defined HPUX && defined WNOHANG)))
6603 #endif /* USG, but not HPUX with WNOHANG */
6606 #endif /* SIGCHLD */
6610 exec_sentinel_unwind (Lisp_Object data
)
6612 XPROCESS (XCAR (data
))->sentinel
= XCDR (data
);
6617 exec_sentinel_error_handler (Lisp_Object error
)
6619 cmd_error_internal (error
, "error in process sentinel: ");
6621 update_echo_area ();
6622 Fsleep_for (make_number (2), Qnil
);
6627 exec_sentinel (Lisp_Object proc
, Lisp_Object reason
)
6629 Lisp_Object sentinel
, obuffer
, odeactivate
, okeymap
;
6630 register struct Lisp_Process
*p
= XPROCESS (proc
);
6631 int count
= SPECPDL_INDEX ();
6632 int outer_running_asynch_code
= running_asynch_code
;
6633 int waiting
= waiting_for_user_input_p
;
6635 if (inhibit_sentinels
)
6638 /* No need to gcpro these, because all we do with them later
6639 is test them for EQness, and none of them should be a string. */
6640 odeactivate
= Vdeactivate_mark
;
6641 XSETBUFFER (obuffer
, current_buffer
);
6642 okeymap
= current_buffer
->keymap
;
6644 /* There's no good reason to let sentinels change the current
6645 buffer, and many callers of accept-process-output, sit-for, and
6646 friends don't expect current-buffer to be changed from under them. */
6647 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
6649 sentinel
= p
->sentinel
;
6650 if (NILP (sentinel
))
6653 /* Zilch the sentinel while it's running, to avoid recursive invocations;
6654 assure that it gets restored no matter how the sentinel exits. */
6656 record_unwind_protect (exec_sentinel_unwind
, Fcons (proc
, sentinel
));
6657 /* Inhibit quit so that random quits don't screw up a running filter. */
6658 specbind (Qinhibit_quit
, Qt
);
6659 specbind (Qlast_nonmenu_event
, Qt
); /* Why? --Stef */
6661 /* In case we get recursively called,
6662 and we already saved the match data nonrecursively,
6663 save the same match data in safely recursive fashion. */
6664 if (outer_running_asynch_code
)
6667 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
6668 restore_search_regs ();
6669 record_unwind_save_match_data ();
6670 Fset_match_data (tem
, Qt
);
6673 /* For speed, if a search happens within this code,
6674 save the match data in a special nonrecursive fashion. */
6675 running_asynch_code
= 1;
6677 internal_condition_case_1 (read_process_output_call
,
6679 Fcons (proc
, Fcons (reason
, Qnil
))),
6680 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
6681 exec_sentinel_error_handler
);
6683 /* If we saved the match data nonrecursively, restore it now. */
6684 restore_search_regs ();
6685 running_asynch_code
= outer_running_asynch_code
;
6687 Vdeactivate_mark
= odeactivate
;
6689 /* Restore waiting_for_user_input_p as it was
6690 when we were called, in case the filter clobbered it. */
6691 waiting_for_user_input_p
= waiting
;
6694 if (! EQ (Fcurrent_buffer (), obuffer
)
6695 || ! EQ (current_buffer
->keymap
, okeymap
))
6697 /* But do it only if the caller is actually going to read events.
6698 Otherwise there's no need to make him wake up, and it could
6699 cause trouble (for example it would make sit_for return). */
6700 if (waiting_for_user_input_p
== -1)
6701 record_asynch_buffer_change ();
6703 unbind_to (count
, Qnil
);
6706 /* Report all recent events of a change in process status
6707 (either run the sentinel or output a message).
6708 This is usually done while Emacs is waiting for keyboard input
6709 but can be done at other times. */
6712 status_notify (struct Lisp_Process
*deleting_process
)
6714 register Lisp_Object proc
, buffer
;
6715 Lisp_Object tail
, msg
;
6716 struct gcpro gcpro1
, gcpro2
;
6720 /* We need to gcpro tail; if read_process_output calls a filter
6721 which deletes a process and removes the cons to which tail points
6722 from Vprocess_alist, and then causes a GC, tail is an unprotected
6726 /* Set this now, so that if new processes are created by sentinels
6727 that we run, we get called again to handle their status changes. */
6728 update_tick
= process_tick
;
6730 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
6733 register struct Lisp_Process
*p
;
6735 proc
= Fcdr (XCAR (tail
));
6736 p
= XPROCESS (proc
);
6738 if (p
->tick
!= p
->update_tick
)
6740 p
->update_tick
= p
->tick
;
6742 /* If process is still active, read any output that remains. */
6743 while (! EQ (p
->filter
, Qt
)
6744 && ! EQ (p
->status
, Qconnect
)
6745 && ! EQ (p
->status
, Qlisten
)
6746 /* Network or serial process not stopped: */
6747 && ! EQ (p
->command
, Qt
)
6749 && p
!= deleting_process
6750 && read_process_output (proc
, p
->infd
) > 0);
6754 /* Get the text to use for the message. */
6755 if (p
->raw_status_new
)
6757 msg
= status_message (p
);
6759 /* If process is terminated, deactivate it or delete it. */
6761 if (CONSP (p
->status
))
6762 symbol
= XCAR (p
->status
);
6764 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
6765 || EQ (symbol
, Qclosed
))
6767 if (delete_exited_processes
)
6768 remove_process (proc
);
6770 deactivate_process (proc
);
6773 /* The actions above may have further incremented p->tick.
6774 So set p->update_tick again
6775 so that an error in the sentinel will not cause
6776 this code to be run again. */
6777 p
->update_tick
= p
->tick
;
6778 /* Now output the message suitably. */
6779 if (!NILP (p
->sentinel
))
6780 exec_sentinel (proc
, msg
);
6781 /* Don't bother with a message in the buffer
6782 when a process becomes runnable. */
6783 else if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
6786 struct buffer
*old
= current_buffer
;
6787 int opoint
, opoint_byte
;
6788 int before
, before_byte
;
6790 /* Avoid error if buffer is deleted
6791 (probably that's why the process is dead, too) */
6792 if (NILP (XBUFFER (buffer
)->name
))
6794 Fset_buffer (buffer
);
6797 opoint_byte
= PT_BYTE
;
6798 /* Insert new output into buffer
6799 at the current end-of-output marker,
6800 thus preserving logical ordering of input and output. */
6801 if (XMARKER (p
->mark
)->buffer
)
6802 Fgoto_char (p
->mark
);
6804 SET_PT_BOTH (ZV
, ZV_BYTE
);
6807 before_byte
= PT_BYTE
;
6809 tem
= current_buffer
->read_only
;
6810 current_buffer
->read_only
= Qnil
;
6811 insert_string ("\nProcess ");
6812 Finsert (1, &p
->name
);
6813 insert_string (" ");
6815 current_buffer
->read_only
= tem
;
6816 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
6818 if (opoint
>= before
)
6819 SET_PT_BOTH (opoint
+ (PT
- before
),
6820 opoint_byte
+ (PT_BYTE
- before_byte
));
6822 SET_PT_BOTH (opoint
, opoint_byte
);
6824 set_buffer_internal (old
);
6829 update_mode_lines
++; /* in case buffers use %s in mode-line-format */
6834 DEFUN ("set-process-coding-system", Fset_process_coding_system
,
6835 Sset_process_coding_system
, 1, 3, 0,
6836 doc
: /* Set coding systems of PROCESS to DECODING and ENCODING.
6837 DECODING will be used to decode subprocess output and ENCODING to
6838 encode subprocess input. */)
6839 (register Lisp_Object process
, Lisp_Object decoding
, Lisp_Object encoding
)
6841 register struct Lisp_Process
*p
;
6843 CHECK_PROCESS (process
);
6844 p
= XPROCESS (process
);
6846 error ("Input file descriptor of %s closed", SDATA (p
->name
));
6848 error ("Output file descriptor of %s closed", SDATA (p
->name
));
6849 Fcheck_coding_system (decoding
);
6850 Fcheck_coding_system (encoding
);
6851 encoding
= coding_inherit_eol_type (encoding
, Qnil
);
6852 p
->decode_coding_system
= decoding
;
6853 p
->encode_coding_system
= encoding
;
6854 setup_process_coding_systems (process
);
6859 DEFUN ("process-coding-system",
6860 Fprocess_coding_system
, Sprocess_coding_system
, 1, 1, 0,
6861 doc
: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
6862 (register Lisp_Object process
)
6864 CHECK_PROCESS (process
);
6865 return Fcons (XPROCESS (process
)->decode_coding_system
,
6866 XPROCESS (process
)->encode_coding_system
);
6869 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte
,
6870 Sset_process_filter_multibyte
, 2, 2, 0,
6871 doc
: /* Set multibyteness of the strings given to PROCESS's filter.
6872 If FLAG is non-nil, the filter is given multibyte strings.
6873 If FLAG is nil, the filter is given unibyte strings. In this case,
6874 all character code conversion except for end-of-line conversion is
6876 (Lisp_Object process
, Lisp_Object flag
)
6878 register struct Lisp_Process
*p
;
6880 CHECK_PROCESS (process
);
6881 p
= XPROCESS (process
);
6883 p
->decode_coding_system
= raw_text_coding_system (p
->decode_coding_system
);
6884 setup_process_coding_systems (process
);
6889 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p
,
6890 Sprocess_filter_multibyte_p
, 1, 1, 0,
6891 doc
: /* Return t if a multibyte string is given to PROCESS's filter.*/)
6892 (Lisp_Object process
)
6894 register struct Lisp_Process
*p
;
6895 struct coding_system
*coding
;
6897 CHECK_PROCESS (process
);
6898 p
= XPROCESS (process
);
6899 coding
= proc_decode_coding_system
[p
->infd
];
6900 return (CODING_FOR_UNIBYTE (coding
) ? Qnil
: Qt
);
6906 /* Add DESC to the set of keyboard input descriptors. */
6909 add_keyboard_wait_descriptor (int desc
)
6911 FD_SET (desc
, &input_wait_mask
);
6912 FD_SET (desc
, &non_process_wait_mask
);
6913 if (desc
> max_keyboard_desc
)
6914 max_keyboard_desc
= desc
;
6917 static int add_gpm_wait_descriptor_called_flag
;
6920 add_gpm_wait_descriptor (int desc
)
6922 if (! add_gpm_wait_descriptor_called_flag
)
6923 FD_CLR (0, &input_wait_mask
);
6924 add_gpm_wait_descriptor_called_flag
= 1;
6925 FD_SET (desc
, &input_wait_mask
);
6926 FD_SET (desc
, &gpm_wait_mask
);
6927 if (desc
> max_gpm_desc
)
6928 max_gpm_desc
= desc
;
6931 /* From now on, do not expect DESC to give keyboard input. */
6934 delete_keyboard_wait_descriptor (int desc
)
6937 int lim
= max_keyboard_desc
;
6939 FD_CLR (desc
, &input_wait_mask
);
6940 FD_CLR (desc
, &non_process_wait_mask
);
6942 if (desc
== max_keyboard_desc
)
6943 for (fd
= 0; fd
< lim
; fd
++)
6944 if (FD_ISSET (fd
, &input_wait_mask
)
6945 && !FD_ISSET (fd
, &non_keyboard_wait_mask
)
6946 && !FD_ISSET (fd
, &gpm_wait_mask
))
6947 max_keyboard_desc
= fd
;
6951 delete_gpm_wait_descriptor (int desc
)
6954 int lim
= max_gpm_desc
;
6956 FD_CLR (desc
, &input_wait_mask
);
6957 FD_CLR (desc
, &non_process_wait_mask
);
6959 if (desc
== max_gpm_desc
)
6960 for (fd
= 0; fd
< lim
; fd
++)
6961 if (FD_ISSET (fd
, &input_wait_mask
)
6962 && !FD_ISSET (fd
, &non_keyboard_wait_mask
)
6963 && !FD_ISSET (fd
, &non_process_wait_mask
))
6967 /* Return nonzero if *MASK has a bit set
6968 that corresponds to one of the keyboard input descriptors. */
6971 keyboard_bit_set (fd_set
*mask
)
6975 for (fd
= 0; fd
<= max_keyboard_desc
; fd
++)
6976 if (FD_ISSET (fd
, mask
) && FD_ISSET (fd
, &input_wait_mask
)
6977 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6983 #else /* not subprocesses */
6985 /* Defined on msdos.c. */
6986 extern int sys_select (int, SELECT_TYPE
*, SELECT_TYPE
*, SELECT_TYPE
*,
6989 /* Implementation of wait_reading_process_output, assuming that there
6990 are no subprocesses. Used only by the MS-DOS build.
6992 Wait for timeout to elapse and/or keyboard input to be available.
6995 timeout in seconds, or
6996 zero for no limit, or
6997 -1 means gobble data immediately available but don't wait for any.
6999 read_kbd is a Lisp_Object:
7000 0 to ignore keyboard input, or
7001 1 to return when input is available, or
7002 -1 means caller will actually read the input, so don't throw to
7005 see full version for other parameters. We know that wait_proc will
7006 always be NULL, since `subprocesses' isn't defined.
7008 do_display != 0 means redisplay should be done to show subprocess
7009 output that arrives.
7011 Return true if we received input from any process. */
7014 wait_reading_process_output (time_limit
, microsecs
, read_kbd
, do_display
,
7015 wait_for_cell
, wait_proc
, just_wait_proc
)
7016 int time_limit
, microsecs
, read_kbd
, do_display
;
7017 Lisp_Object wait_for_cell
;
7018 struct Lisp_Process
*wait_proc
;
7022 EMACS_TIME end_time
, timeout
;
7023 SELECT_TYPE waitchannels
;
7026 /* What does time_limit really mean? */
7027 if (time_limit
|| microsecs
)
7029 EMACS_GET_TIME (end_time
);
7030 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
7031 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
7034 /* Turn off periodic alarms (in case they are in use)
7035 and then turn off any other atimers,
7036 because the select emulator uses alarms. */
7038 turn_on_atimers (0);
7042 int timeout_reduced_for_timers
= 0;
7044 /* If calling from keyboard input, do not quit
7045 since we want to return C-g as an input character.
7046 Otherwise, do pending quit if requested. */
7050 /* Exit now if the cell we're waiting for became non-nil. */
7051 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7054 /* Compute time from now till when time limit is up */
7055 /* Exit if already run out */
7056 if (time_limit
== -1)
7058 /* -1 specified for timeout means
7059 gobble output available now
7060 but don't wait at all. */
7062 EMACS_SET_SECS_USECS (timeout
, 0, 0);
7064 else if (time_limit
|| microsecs
)
7066 EMACS_GET_TIME (timeout
);
7067 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
7068 if (EMACS_TIME_NEG_P (timeout
))
7073 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
7076 /* If our caller will not immediately handle keyboard events,
7077 run timer events directly.
7078 (Callers that will immediately read keyboard events
7079 call timer_delay on their own.) */
7080 if (NILP (wait_for_cell
))
7082 EMACS_TIME timer_delay
;
7086 int old_timers_run
= timers_run
;
7087 timer_delay
= timer_check (1);
7088 if (timers_run
!= old_timers_run
&& do_display
)
7089 /* We must retry, since a timer may have requeued itself
7090 and that could alter the time delay. */
7091 redisplay_preserve_echo_area (14);
7095 while (!detect_input_pending ());
7097 /* If there is unread keyboard input, also return. */
7099 && requeued_events_pending_p ())
7102 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
7104 EMACS_TIME difference
;
7105 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
7106 if (EMACS_TIME_NEG_P (difference
))
7108 timeout
= timer_delay
;
7109 timeout_reduced_for_timers
= 1;
7114 /* Cause C-g and alarm signals to take immediate action,
7115 and cause input available signals to zero out timeout. */
7117 set_waiting_for_input (&timeout
);
7119 /* Wait till there is something to do. */
7121 if (! read_kbd
&& NILP (wait_for_cell
))
7122 FD_ZERO (&waitchannels
);
7124 FD_SET (0, &waitchannels
);
7126 /* If a frame has been newly mapped and needs updating,
7127 reprocess its display stuff. */
7128 if (frame_garbaged
&& do_display
)
7130 clear_waiting_for_input ();
7131 redisplay_preserve_echo_area (15);
7133 set_waiting_for_input (&timeout
);
7136 if (read_kbd
&& detect_input_pending ())
7139 FD_ZERO (&waitchannels
);
7142 nfds
= select (1, &waitchannels
, (SELECT_TYPE
*)0, (SELECT_TYPE
*)0,
7147 /* Make C-g and alarm signals set flags again */
7148 clear_waiting_for_input ();
7150 /* If we woke up due to SIGWINCH, actually change size now. */
7151 do_pending_window_change (0);
7153 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
7154 /* We waited the full specified time, so return now. */
7159 /* If the system call was interrupted, then go around the
7161 if (xerrno
== EINTR
)
7162 FD_ZERO (&waitchannels
);
7164 error ("select error: %s", emacs_strerror (xerrno
));
7167 /* Check for keyboard input */
7170 && detect_input_pending_run_timers (do_display
))
7172 swallow_events (do_display
);
7173 if (detect_input_pending_run_timers (do_display
))
7177 /* If there is unread keyboard input, also return. */
7179 && requeued_events_pending_p ())
7182 /* If wait_for_cell. check for keyboard input
7183 but don't run any timers.
7184 ??? (It seems wrong to me to check for keyboard
7185 input at all when wait_for_cell, but the code
7186 has been this way since July 1994.
7187 Try changing this after version 19.31.) */
7188 if (! NILP (wait_for_cell
)
7189 && detect_input_pending ())
7191 swallow_events (do_display
);
7192 if (detect_input_pending ())
7196 /* Exit now if the cell we're waiting for became non-nil. */
7197 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7206 #endif /* not subprocesses */
7208 /* The following functions are needed even if async subprocesses are
7209 not supported. Some of them are no-op stubs in that case. */
7211 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
7212 doc
: /* Return the (or a) process associated with BUFFER.
7213 BUFFER may be a buffer or the name of one. */)
7214 (register Lisp_Object buffer
)
7217 register Lisp_Object buf
, tail
, proc
;
7219 if (NILP (buffer
)) return Qnil
;
7220 buf
= Fget_buffer (buffer
);
7221 if (NILP (buf
)) return Qnil
;
7223 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
7225 proc
= Fcdr (XCAR (tail
));
7226 if (PROCESSP (proc
) && EQ (XPROCESS (proc
)->buffer
, buf
))
7229 #endif /* subprocesses */
7233 DEFUN ("process-inherit-coding-system-flag",
7234 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
7236 doc
: /* Return the value of inherit-coding-system flag for PROCESS.
7237 If this flag is t, `buffer-file-coding-system' of the buffer
7238 associated with PROCESS will inherit the coding system used to decode
7239 the process output. */)
7240 (register Lisp_Object process
)
7243 CHECK_PROCESS (process
);
7244 return XPROCESS (process
)->inherit_coding_system_flag
? Qt
: Qnil
;
7246 /* Ignore the argument and return the value of
7247 inherit-process-coding-system. */
7248 return inherit_process_coding_system
? Qt
: Qnil
;
7252 /* Kill all processes associated with `buffer'.
7253 If `buffer' is nil, kill all processes */
7256 kill_buffer_processes (Lisp_Object buffer
)
7259 Lisp_Object tail
, proc
;
7261 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
7263 proc
= XCDR (XCAR (tail
));
7265 && (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
)))
7267 if (NETCONN_P (proc
) || SERIALCONN_P (proc
))
7268 Fdelete_process (proc
);
7269 else if (XPROCESS (proc
)->infd
>= 0)
7270 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
7273 #else /* subprocesses */
7274 /* Since we have no subprocesses, this does nothing. */
7275 #endif /* subprocesses */
7278 /* Stop reading input from keyboard sources. */
7281 hold_keyboard_input (void)
7286 /* Resume reading input from keyboard sources. */
7289 unhold_keyboard_input (void)
7294 /* Return non-zero if keyboard input is on hold, zero otherwise. */
7297 kbd_on_hold_p (void)
7299 return kbd_is_on_hold
;
7303 /* Enumeration of and access to system processes a-la ps(1). */
7305 DEFUN ("list-system-processes", Flist_system_processes
, Slist_system_processes
,
7307 doc
: /* Return a list of numerical process IDs of all running processes.
7308 If this functionality is unsupported, return nil.
7310 See `process-attributes' for getting attributes of a process given its ID. */)
7313 return list_system_processes ();
7316 DEFUN ("process-attributes", Fprocess_attributes
,
7317 Sprocess_attributes
, 1, 1, 0,
7318 doc
: /* Return attributes of the process given by its PID, a number.
7320 Value is an alist where each element is a cons cell of the form
7324 If this functionality is unsupported, the value is nil.
7326 See `list-system-processes' for getting a list of all process IDs.
7328 The KEYs of the attributes that this function may return are listed
7329 below, together with the type of the associated VALUE (in parentheses).
7330 Not all platforms support all of these attributes; unsupported
7331 attributes will not appear in the returned alist.
7332 Unless explicitly indicated otherwise, numbers can have either
7333 integer or floating point values.
7335 euid -- Effective user User ID of the process (number)
7336 user -- User name corresponding to euid (string)
7337 egid -- Effective user Group ID of the process (number)
7338 group -- Group name corresponding to egid (string)
7339 comm -- Command name (executable name only) (string)
7340 state -- Process state code, such as "S", "R", or "T" (string)
7341 ppid -- Parent process ID (number)
7342 pgrp -- Process group ID (number)
7343 sess -- Session ID, i.e. process ID of session leader (number)
7344 ttname -- Controlling tty name (string)
7345 tpgid -- ID of foreground process group on the process's tty (number)
7346 minflt -- number of minor page faults (number)
7347 majflt -- number of major page faults (number)
7348 cminflt -- cumulative number of minor page faults (number)
7349 cmajflt -- cumulative number of major page faults (number)
7350 utime -- user time used by the process, in the (HIGH LOW USEC) format
7351 stime -- system time used by the process, in the (HIGH LOW USEC) format
7352 time -- sum of utime and stime, in the (HIGH LOW USEC) format
7353 cutime -- user time used by the process and its children, (HIGH LOW USEC)
7354 cstime -- system time used by the process and its children, (HIGH LOW USEC)
7355 ctime -- sum of cutime and cstime, in the (HIGH LOW USEC) format
7356 pri -- priority of the process (number)
7357 nice -- nice value of the process (number)
7358 thcount -- process thread count (number)
7359 start -- time the process started, in the (HIGH LOW USEC) format
7360 vsize -- virtual memory size of the process in KB's (number)
7361 rss -- resident set size of the process in KB's (number)
7362 etime -- elapsed time the process is running, in (HIGH LOW USEC) format
7363 pcpu -- percents of CPU time used by the process (floating-point number)
7364 pmem -- percents of total physical memory used by process's resident set
7365 (floating-point number)
7366 args -- command line which invoked the process (string). */)
7369 return system_process_attributes (pid
);
7379 inhibit_sentinels
= 0;
7383 if (! noninteractive
|| initialized
)
7385 signal (SIGCHLD
, sigchld_handler
);
7388 FD_ZERO (&input_wait_mask
);
7389 FD_ZERO (&non_keyboard_wait_mask
);
7390 FD_ZERO (&non_process_wait_mask
);
7391 max_process_desc
= 0;
7393 #ifdef NON_BLOCKING_CONNECT
7394 FD_ZERO (&connect_wait_mask
);
7395 num_pending_connects
= 0;
7398 #ifdef ADAPTIVE_READ_BUFFERING
7399 process_output_delay_count
= 0;
7400 process_output_skip
= 0;
7403 /* Don't do this, it caused infinite select loops. The display
7404 method should call add_keyboard_wait_descriptor on stdin if it
7407 FD_SET (0, &input_wait_mask
);
7410 Vprocess_alist
= Qnil
;
7412 deleted_pid_list
= Qnil
;
7414 for (i
= 0; i
< MAXDESC
; i
++)
7416 chan_process
[i
] = Qnil
;
7417 proc_buffered_char
[i
] = -1;
7419 memset (proc_decode_coding_system
, 0, sizeof proc_decode_coding_system
);
7420 memset (proc_encode_coding_system
, 0, sizeof proc_encode_coding_system
);
7421 #ifdef DATAGRAM_SOCKETS
7422 memset (datagram_address
, 0, sizeof datagram_address
);
7427 Lisp_Object subfeatures
= Qnil
;
7428 const struct socket_options
*sopt
;
7430 #define ADD_SUBFEATURE(key, val) \
7431 subfeatures = pure_cons (pure_cons (key, pure_cons (val, Qnil)), subfeatures)
7433 #ifdef NON_BLOCKING_CONNECT
7434 ADD_SUBFEATURE (QCnowait
, Qt
);
7436 #ifdef DATAGRAM_SOCKETS
7437 ADD_SUBFEATURE (QCtype
, Qdatagram
);
7439 #ifdef HAVE_SEQPACKET
7440 ADD_SUBFEATURE (QCtype
, Qseqpacket
);
7442 #ifdef HAVE_LOCAL_SOCKETS
7443 ADD_SUBFEATURE (QCfamily
, Qlocal
);
7445 ADD_SUBFEATURE (QCfamily
, Qipv4
);
7447 ADD_SUBFEATURE (QCfamily
, Qipv6
);
7449 #ifdef HAVE_GETSOCKNAME
7450 ADD_SUBFEATURE (QCservice
, Qt
);
7452 #if defined(O_NONBLOCK) || defined(O_NDELAY)
7453 ADD_SUBFEATURE (QCserver
, Qt
);
7456 for (sopt
= socket_options
; sopt
->name
; sopt
++)
7457 subfeatures
= pure_cons (intern_c_string (sopt
->name
), subfeatures
);
7459 Fprovide (intern_c_string ("make-network-process"), subfeatures
);
7461 #endif /* HAVE_SOCKETS */
7463 #if defined (DARWIN_OS)
7464 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
7465 processes. As such, we only change the default value. */
7468 char *release
= get_operating_system_release ();
7469 if (!release
|| !release
[0] || (release
[0] < MIN_PTY_KERNEL_VERSION
7470 && release
[1] == '.')) {
7471 Vprocess_connection_type
= Qnil
;
7475 #endif /* subprocesses */
7480 syms_of_process (void)
7484 Qprocessp
= intern_c_string ("processp");
7485 staticpro (&Qprocessp
);
7486 Qrun
= intern_c_string ("run");
7488 Qstop
= intern_c_string ("stop");
7490 Qsignal
= intern_c_string ("signal");
7491 staticpro (&Qsignal
);
7493 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
7496 Qexit = intern_c_string ("exit");
7497 staticpro (&Qexit); */
7499 Qopen
= intern_c_string ("open");
7501 Qclosed
= intern_c_string ("closed");
7502 staticpro (&Qclosed
);
7503 Qconnect
= intern_c_string ("connect");
7504 staticpro (&Qconnect
);
7505 Qfailed
= intern_c_string ("failed");
7506 staticpro (&Qfailed
);
7507 Qlisten
= intern_c_string ("listen");
7508 staticpro (&Qlisten
);
7509 Qlocal
= intern_c_string ("local");
7510 staticpro (&Qlocal
);
7511 Qipv4
= intern_c_string ("ipv4");
7514 Qipv6
= intern_c_string ("ipv6");
7517 Qdatagram
= intern_c_string ("datagram");
7518 staticpro (&Qdatagram
);
7519 Qseqpacket
= intern_c_string ("seqpacket");
7520 staticpro (&Qseqpacket
);
7522 QCport
= intern_c_string (":port");
7523 staticpro (&QCport
);
7524 QCspeed
= intern_c_string (":speed");
7525 staticpro (&QCspeed
);
7526 QCprocess
= intern_c_string (":process");
7527 staticpro (&QCprocess
);
7529 QCbytesize
= intern_c_string (":bytesize");
7530 staticpro (&QCbytesize
);
7531 QCstopbits
= intern_c_string (":stopbits");
7532 staticpro (&QCstopbits
);
7533 QCparity
= intern_c_string (":parity");
7534 staticpro (&QCparity
);
7535 Qodd
= intern_c_string ("odd");
7537 Qeven
= intern_c_string ("even");
7539 QCflowcontrol
= intern_c_string (":flowcontrol");
7540 staticpro (&QCflowcontrol
);
7541 Qhw
= intern_c_string ("hw");
7543 Qsw
= intern_c_string ("sw");
7545 QCsummary
= intern_c_string (":summary");
7546 staticpro (&QCsummary
);
7548 Qreal
= intern_c_string ("real");
7550 Qnetwork
= intern_c_string ("network");
7551 staticpro (&Qnetwork
);
7552 Qserial
= intern_c_string ("serial");
7553 staticpro (&Qserial
);
7554 QCbuffer
= intern_c_string (":buffer");
7555 staticpro (&QCbuffer
);
7556 QChost
= intern_c_string (":host");
7557 staticpro (&QChost
);
7558 QCservice
= intern_c_string (":service");
7559 staticpro (&QCservice
);
7560 QClocal
= intern_c_string (":local");
7561 staticpro (&QClocal
);
7562 QCremote
= intern_c_string (":remote");
7563 staticpro (&QCremote
);
7564 QCcoding
= intern_c_string (":coding");
7565 staticpro (&QCcoding
);
7566 QCserver
= intern_c_string (":server");
7567 staticpro (&QCserver
);
7568 QCnowait
= intern_c_string (":nowait");
7569 staticpro (&QCnowait
);
7570 QCsentinel
= intern_c_string (":sentinel");
7571 staticpro (&QCsentinel
);
7572 QClog
= intern_c_string (":log");
7574 QCnoquery
= intern_c_string (":noquery");
7575 staticpro (&QCnoquery
);
7576 QCstop
= intern_c_string (":stop");
7577 staticpro (&QCstop
);
7578 QCoptions
= intern_c_string (":options");
7579 staticpro (&QCoptions
);
7580 QCplist
= intern_c_string (":plist");
7581 staticpro (&QCplist
);
7583 Qlast_nonmenu_event
= intern_c_string ("last-nonmenu-event");
7584 staticpro (&Qlast_nonmenu_event
);
7586 staticpro (&Vprocess_alist
);
7588 staticpro (&deleted_pid_list
);
7591 #endif /* subprocesses */
7593 QCname
= intern_c_string (":name");
7594 staticpro (&QCname
);
7595 QCtype
= intern_c_string (":type");
7596 staticpro (&QCtype
);
7598 Qeuid
= intern_c_string ("euid");
7600 Qegid
= intern_c_string ("egid");
7602 Quser
= intern_c_string ("user");
7604 Qgroup
= intern_c_string ("group");
7605 staticpro (&Qgroup
);
7606 Qcomm
= intern_c_string ("comm");
7608 Qstate
= intern_c_string ("state");
7609 staticpro (&Qstate
);
7610 Qppid
= intern_c_string ("ppid");
7612 Qpgrp
= intern_c_string ("pgrp");
7614 Qsess
= intern_c_string ("sess");
7616 Qttname
= intern_c_string ("ttname");
7617 staticpro (&Qttname
);
7618 Qtpgid
= intern_c_string ("tpgid");
7619 staticpro (&Qtpgid
);
7620 Qminflt
= intern_c_string ("minflt");
7621 staticpro (&Qminflt
);
7622 Qmajflt
= intern_c_string ("majflt");
7623 staticpro (&Qmajflt
);
7624 Qcminflt
= intern_c_string ("cminflt");
7625 staticpro (&Qcminflt
);
7626 Qcmajflt
= intern_c_string ("cmajflt");
7627 staticpro (&Qcmajflt
);
7628 Qutime
= intern_c_string ("utime");
7629 staticpro (&Qutime
);
7630 Qstime
= intern_c_string ("stime");
7631 staticpro (&Qstime
);
7632 Qtime
= intern_c_string ("time");
7634 Qcutime
= intern_c_string ("cutime");
7635 staticpro (&Qcutime
);
7636 Qcstime
= intern_c_string ("cstime");
7637 staticpro (&Qcstime
);
7638 Qctime
= intern_c_string ("ctime");
7639 staticpro (&Qctime
);
7640 Qpri
= intern_c_string ("pri");
7642 Qnice
= intern_c_string ("nice");
7644 Qthcount
= intern_c_string ("thcount");
7645 staticpro (&Qthcount
);
7646 Qstart
= intern_c_string ("start");
7647 staticpro (&Qstart
);
7648 Qvsize
= intern_c_string ("vsize");
7649 staticpro (&Qvsize
);
7650 Qrss
= intern_c_string ("rss");
7652 Qetime
= intern_c_string ("etime");
7653 staticpro (&Qetime
);
7654 Qpcpu
= intern_c_string ("pcpu");
7656 Qpmem
= intern_c_string ("pmem");
7658 Qargs
= intern_c_string ("args");
7661 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes
,
7662 doc
: /* *Non-nil means delete processes immediately when they exit.
7663 A value of nil means don't delete them until `list-processes' is run. */);
7665 delete_exited_processes
= 1;
7668 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type
,
7669 doc
: /* Control type of device used to communicate with subprocesses.
7670 Values are nil to use a pipe, or t or `pty' to use a pty.
7671 The value has no effect if the system has no ptys or if all ptys are busy:
7672 then a pipe is used in any case.
7673 The value takes effect when `start-process' is called. */);
7674 Vprocess_connection_type
= Qt
;
7676 #ifdef ADAPTIVE_READ_BUFFERING
7677 DEFVAR_LISP ("process-adaptive-read-buffering", &Vprocess_adaptive_read_buffering
,
7678 doc
: /* If non-nil, improve receive buffering by delaying after short reads.
7679 On some systems, when Emacs reads the output from a subprocess, the output data
7680 is read in very small blocks, potentially resulting in very poor performance.
7681 This behavior can be remedied to some extent by setting this variable to a
7682 non-nil value, as it will automatically delay reading from such processes, to
7683 allow them to produce more output before Emacs tries to read it.
7684 If the value is t, the delay is reset after each write to the process; any other
7685 non-nil value means that the delay is not reset on write.
7686 The variable takes effect when `start-process' is called. */);
7687 Vprocess_adaptive_read_buffering
= Qt
;
7690 defsubr (&Sprocessp
);
7691 defsubr (&Sget_process
);
7692 defsubr (&Sdelete_process
);
7693 defsubr (&Sprocess_status
);
7694 defsubr (&Sprocess_exit_status
);
7695 defsubr (&Sprocess_id
);
7696 defsubr (&Sprocess_name
);
7697 defsubr (&Sprocess_tty_name
);
7698 defsubr (&Sprocess_command
);
7699 defsubr (&Sset_process_buffer
);
7700 defsubr (&Sprocess_buffer
);
7701 defsubr (&Sprocess_mark
);
7702 defsubr (&Sset_process_filter
);
7703 defsubr (&Sprocess_filter
);
7704 defsubr (&Sset_process_sentinel
);
7705 defsubr (&Sprocess_sentinel
);
7706 defsubr (&Sset_process_window_size
);
7707 defsubr (&Sset_process_inherit_coding_system_flag
);
7708 defsubr (&Sset_process_query_on_exit_flag
);
7709 defsubr (&Sprocess_query_on_exit_flag
);
7710 defsubr (&Sprocess_contact
);
7711 defsubr (&Sprocess_plist
);
7712 defsubr (&Sset_process_plist
);
7713 defsubr (&Slist_processes
);
7714 defsubr (&Sprocess_list
);
7715 defsubr (&Sstart_process
);
7717 defsubr (&Sserial_process_configure
);
7718 defsubr (&Smake_serial_process
);
7719 #endif /* HAVE_SERIAL */
7721 defsubr (&Sset_network_process_option
);
7722 defsubr (&Smake_network_process
);
7723 defsubr (&Sformat_network_address
);
7724 #endif /* HAVE_SOCKETS */
7725 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
7727 defsubr (&Snetwork_interface_list
);
7729 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
7730 defsubr (&Snetwork_interface_info
);
7732 #endif /* HAVE_SOCKETS ... */
7733 #ifdef DATAGRAM_SOCKETS
7734 defsubr (&Sprocess_datagram_address
);
7735 defsubr (&Sset_process_datagram_address
);
7737 defsubr (&Saccept_process_output
);
7738 defsubr (&Sprocess_send_region
);
7739 defsubr (&Sprocess_send_string
);
7740 defsubr (&Sinterrupt_process
);
7741 defsubr (&Skill_process
);
7742 defsubr (&Squit_process
);
7743 defsubr (&Sstop_process
);
7744 defsubr (&Scontinue_process
);
7745 defsubr (&Sprocess_running_child_p
);
7746 defsubr (&Sprocess_send_eof
);
7747 defsubr (&Ssignal_process
);
7748 defsubr (&Swaiting_for_user_input_p
);
7749 defsubr (&Sprocess_type
);
7750 defsubr (&Sset_process_coding_system
);
7751 defsubr (&Sprocess_coding_system
);
7752 defsubr (&Sset_process_filter_multibyte
);
7753 defsubr (&Sprocess_filter_multibyte_p
);
7755 #endif /* subprocesses */
7757 defsubr (&Sget_buffer_process
);
7758 defsubr (&Sprocess_inherit_coding_system_flag
);
7759 defsubr (&Slist_system_processes
);
7760 defsubr (&Sprocess_attributes
);
7763 /* arch-tag: 3706c011-7b9a-4117-bd4f-59e7f701a4c4
7764 (do not change this comment) */