1 /* Asynchronous subprocess control for SXEmacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993, 1994, 1995, 2003
3 Free Software Foundation, Inc.
4 Copyright (C) 1995 Sun Microsystems, Inc.
5 Copyright (C) 1995, 1996 Ben Wing.
7 This file is part of SXEmacs
9 SXEmacs is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
14 SXEmacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with this program. If not, see <http://www.gnu.org/licenses/>. */
23 /* This file has been Mule-ized except for `start-process-internal',
24 `open-network-stream-internal' and `open-multicast-group-internal'. */
26 /* This file has been split into process.c and process-unix.c by
27 Kirill M. Katsnelson <kkm@kis.ru>, so please bash him and not
28 the original author(s) */
32 #if !defined (NO_SUBPROCESSES)
34 /* The entire file is within this conditional */
40 #include "events/events.h"
43 #include "ui/insdel.h"
48 #include "ui/window.h"
50 #include "mule/file-coding.h"
56 #include "syssignal.h" /* Always include before systty.h */
57 #include "ui/systty.h"
60 #if defined(HAVE_OPENSSL) && defined(OPENSSL_SSL)
65 Lisp_Object Qprocessp, Qprocess_live_p, Qprocess_readable_p;
68 struct process_methods the_process_methods;
70 /* a process object is a network connection when its pid field a cons
71 (name of name of port we are connected to . foreign host name) */
73 /* valid objects to server stream host parameter */
74 Lisp_Object Qip_any, Qlocalhost;
77 /* Valid values of process->status_symbol */
78 Lisp_Object Qrun, Qstop;
79 /* Qrun => Qopen, Qexit => Qclosed for "network connection" processes */
80 Lisp_Object Qopen, Qclosed;
81 /* Protocol families */
82 Lisp_Object Qtcp, Qudp;
85 Lisp_Object Qmulticast; /* Will be used for occasional warnings */
88 /* t means use pty, nil means use a pipe,
89 maybe other values to come. */
90 Lisp_Object Vprocess_connection_type;
92 /* Read comments to DEFVAR of this */
93 int windowed_process_io;
95 #ifdef PROCESS_IO_BLOCKING
96 /* List of port numbers or port names to set a blocking I/O mode.
97 Nil means set a non-blocking I/O mode [default]. */
98 Lisp_Object network_stream_blocking_port_list;
99 #endif /* PROCESS_IO_BLOCKING */
101 /* Number of events of change of status of a process. */
102 volatile int process_tick;
104 /* Number of events for which the user or sentinel has been notified. */
105 static int update_tick;
107 /* Nonzero means delete a process right away if it exits. */
108 int delete_exited_processes;
110 /* Hash table which maps USIDs as returned by create_stream_pair_cb to
111 process objects. Processes are not GC-protected through this! */
112 struct hash_table *usid_to_process;
113 Lisp_Object Vusid_to_process;
115 /* List of process objects. */
116 Lisp_Object Vprocess_list;
118 extern Lisp_Object Vlisp_EXEC_SUFFIXES;
119 Lisp_Object Vnull_device;
121 static Lisp_Object mark_process(Lisp_Object object)
123 Lisp_Process *process = XPROCESS(object);
124 MAYBE_PROCMETH(mark_process_data, (process));
125 mark_object(process->name);
126 mark_object(process->command);
127 mark_object(process->filter);
128 mark_object(process->sentinel);
129 mark_object(process->buffer);
130 mark_object(process->mark);
131 mark_object(process->pid);
132 mark_object(process->pipe_instream);
133 mark_object(process->pipe_outstream);
135 mark_object(process->coding_instream);
136 mark_object(process->coding_outstream);
138 mark_object(process->process_type_data);
139 return process->status_symbol;
143 print_process(Lisp_Object object, Lisp_Object printcharfun, int escapeflag)
145 Lisp_Process *process = XPROCESS(object);
148 error("printing unreadable object #<process %s>",
149 XSTRING_DATA(process->name));
152 print_internal(process->name, printcharfun, 0);
154 /* int netp = network_connection_p(object); */
155 int netp = ((process->process_type == PROCESS_TYPE_NETWORK) ||
156 (process->process_type == PROCESS_TYPE_MULTICAST) ||
157 (process->process_type == PROCESS_TYPE_SSL) ||
158 (process->process_type == PROCESS_TYPE_NETWORK_SERVER_LISTEN));
159 switch (process->process_type) {
160 case PROCESS_TYPE_NETWORK:
162 GETTEXT("#<network connection "),
165 case PROCESS_TYPE_NETWORK_SERVER_LISTEN:
167 GETTEXT("#<network server accepting connections "),
170 case PROCESS_TYPE_MULTICAST:
172 GETTEXT("#<multicast network connection "),
175 case PROCESS_TYPE_SSL:
177 GETTEXT("#<secure network connection "),
180 case PROCESS_TYPE_PROC:
183 GETTEXT("#<process "),
187 print_internal(process->name, printcharfun, 1);
188 write_c_string((netp ? " " : " pid "), printcharfun);
189 print_internal(process->pid, printcharfun, 1);
190 write_c_string(" state:", printcharfun);
191 print_internal(process->status_symbol, printcharfun, 1);
192 MAYBE_PROCMETH(print_process_data, (process, printcharfun));
193 write_c_string(">", printcharfun);
197 #ifdef HAVE_WINDOW_SYSTEM
198 extern void debug_process_finalization(Lisp_Process * p);
199 #endif /* HAVE_WINDOW_SYSTEM */
201 static void finalize_process(void *header, int for_disksave)
203 /* #### this probably needs to be tied into the tty event loop */
204 /* #### when there is one */
205 Lisp_Process *p = (Lisp_Process *) header;
206 #ifdef HAVE_WINDOW_SYSTEM
208 debug_process_finalization(p);
210 #endif /* HAVE_WINDOW_SYSTEM */
212 if (p->process_data) {
213 MAYBE_PROCMETH(finalize_process_data, (p, for_disksave));
215 xfree(p->process_data);
219 DEFINE_LRECORD_IMPLEMENTATION("process", process,
220 mark_process, print_process, finalize_process,
221 0, 0, 0, Lisp_Process);
223 /************************************************************************/
224 /* basic process accessors */
225 /************************************************************************/
227 /* Under FILE_CODING, this function returns low-level streams, connected
228 directly to the child process, rather than en/decoding FILE_CODING
231 get_process_streams(Lisp_Process * p, Lisp_Object * instr, Lisp_Object * outstr)
234 assert(NILP(p->pipe_instream) || LSTREAMP(p->pipe_instream));
235 assert(NILP(p->pipe_outstream) || LSTREAMP(p->pipe_outstream));
236 *instr = p->pipe_instream;
237 *outstr = p->pipe_outstream;
240 Lisp_Process *get_process_from_usid(USID usid)
244 assert(usid != USID_ERROR && usid != USID_DONTHASH);
246 if (gethash((const void *)usid, usid_to_process, &vval)) {
248 CVOID_TO_LISP(process, vval);
249 return XPROCESS(process);
254 int get_process_selected_p(Lisp_Process * p)
259 void set_process_selected_p(Lisp_Process * p, int selected_p)
261 p->selected = !!selected_p;
264 int connected_via_filedesc_p(Lisp_Process * p)
266 return MAYBE_INT_PROCMETH(tooltalk_connection_p, (p));
270 int network_connection_p(Lisp_Object process)
272 return CONSP(XPROCESS(process)->pid);
276 DEFUN("processp", Fprocessp, 1, 1, 0, /*
277 Return t if OBJECT is a process.
281 return PROCESSP(object) ? Qt : Qnil;
284 DEFUN("process-live-p", Fprocess_live_p, 1, 1, 0, /*
285 Return t if OBJECT is a process that is alive.
289 return PROCESSP(object) && PROCESS_LIVE_P(XPROCESS(object))
294 /* This is a reasonable definition for this new primitive. Kyle sez:
296 "The patch looks OK to me except for the creation and exporting of the
297 Fprocess_readable_p function. I don't think a new Lisp function
298 should be created until we know something actually needs it. If
299 we later want to give process-readable-p different semantics it
300 may be hard to do it and stay compatible with what we hastily
303 He's right, not yet. Let's discuss the semantics on XEmacs Design
304 before enabling this.
306 DEFUN("process-readable-p", Fprocess_readable_p, 1, 1, 0, /*
307 Return t if OBJECT is a process from which input may be available.
311 return PROCESSP(object) && PROCESS_READABLE_P(XPROCESS(object))
316 DEFUN("process-list", Fprocess_list, 0, 0, 0, /*
317 Return a list of all processes.
321 return Fcopy_sequence(Vprocess_list);
324 DEFUN("get-process", Fget_process, 1, 1, 0, /*
325 Return the process named PROCESS-NAME (a string), or nil if there is none.
326 PROCESS-NAME may also be a process; if so, the value is that process.
330 if (PROCESSP(process_name))
334 /* this only gets called during GC when emacs is going away as a result
335 of a signal or crash. */
336 CHECK_STRING(process_name);
339 LIST_LOOP_2(process, Vprocess_list)
341 (process_name, XPROCESS(process)->name, 0))
347 DEFUN("get-buffer-process", Fget_buffer_process, 1, 1, 0, /*
348 Return the (or, a) process associated with BUFFER.
349 BUFFER may be a buffer or the name of one.
355 buffer = Fget_buffer(buffer);
360 LIST_LOOP_2(process, Vprocess_list)
361 if (EQ(XPROCESS(process)->buffer, buffer))
367 /* This is how commands for the user decode process arguments. It
368 accepts a process, a process name, a buffer, a buffer name, or nil.
369 Buffers denote the first process in the buffer, and nil denotes the
372 static Lisp_Object get_process(Lisp_Object name)
377 /* #### Look more closely into translating process names. */
380 /* This may be called during a GC from process_send_signal() from
381 kill_buffer_processes() if emacs decides to abort(). */
384 else if (STRINGP(name)) {
385 Lisp_Object object = Fget_process(name);
386 if (PROCESSP(object))
389 buffer = Fget_buffer(name);
391 goto have_buffer_object;
393 error("Process %s does not exist", XSTRING_DATA(name));
394 } else if (NILP(name)) {
395 buffer = Fcurrent_buffer();
396 goto have_buffer_object;
397 } else if (BUFFERP(name)) {
402 process = Fget_buffer_process(buffer);
403 if (PROCESSP(process))
406 error("Buffer %s has no process",
407 XSTRING_DATA(XBUFFER(buffer)->name));
409 return get_process(Fsignal(Qwrong_type_argument,
412 ("process or buffer or nil"),
416 DEFUN("process-id", Fprocess_id, 1, 1, 0, /*
417 Return the process id of PROCESS.
418 This is the pid of the Unix process which PROCESS uses or talks to.
419 For a network connection, this value is a cons of
420 (foreign-network-port . foreign-host-name).
425 CHECK_PROCESS(process);
427 pid = XPROCESS(process)->pid;
428 if (network_connection_p(process))
430 return Fcons(Fcar(pid), Fcdr(pid));
435 DEFUN("process-name", Fprocess_name, 1, 1, 0, /*
436 Return the name of PROCESS, as a string.
437 This is the name of the program invoked in PROCESS,
438 possibly modified to make it unique among process names.
442 CHECK_PROCESS(process);
443 return XPROCESS(process)->name;
446 DEFUN("process-command", Fprocess_command, 1, 1, 0, /*
447 Return the command that was executed to start PROCESS.
448 This is a list of strings, the first string being the program executed
449 and the rest of the strings being the arguments given to it.
453 CHECK_PROCESS(process);
454 return XPROCESS(process)->command;
457 /************************************************************************/
458 /* creating a process */
459 /************************************************************************/
461 Lisp_Object make_process_internal(Lisp_Object name)
463 Lisp_Object val, name1;
465 Lisp_Process *p = alloc_lcrecord_type(Lisp_Process, &lrecord_process);
467 /* If name is already in use, modify it until it is unused. */
471 Lisp_Object tem = Fget_process(name1);
474 sprintf(suffix, "<%d>", i);
475 name1 = concat2(name, build_string(suffix));
484 p->mark = Fmake_marker();
486 p->status_symbol = Qrun;
489 p->filter_does_read = 0;
490 p->kill_without_query = 0;
494 p->pipe_instream = Qnil;
495 p->pipe_outstream = Qnil;
497 p->coding_instream = Qnil;
498 p->coding_outstream = Qnil;
500 p->process_type = PROCESS_TYPE_PROC;
501 p->process_type_data = Qnil;
504 MAYBE_PROCMETH(alloc_process_data, (p));
508 Vprocess_list = Fcons(val, Vprocess_list);
512 void init_process_io_handles(Lisp_Process * p, void *in, void *out, int flags)
514 USID usid = event_stream_create_stream_pair(in, out,
519 if (usid == USID_ERROR)
520 report_file_error("Setting up communication with subprocess",
523 if (usid != USID_DONTHASH) {
524 Lisp_Object process = Qnil;
525 XSETPROCESS(process, p);
526 puthash((const void *)usid, LISP_TO_VOID(process),
530 MAYBE_PROCMETH(init_process_io_handles, (p, in, out, flags));
533 p->coding_instream = make_decoding_input_stream
534 (XLSTREAM(p->pipe_instream),
535 Fget_coding_system(Vcoding_system_for_read));
536 Lstream_set_character_mode(XLSTREAM(p->coding_instream));
537 p->coding_outstream = make_encoding_output_stream
538 (XLSTREAM(p->pipe_outstream),
539 Fget_coding_system(Vcoding_system_for_write));
540 /* CODE_CNTL (&out_state[outchannel]) |= CC_END; !!####
541 What's going on here? */
542 #endif /* FILE_CODING */
546 create_process(Lisp_Object process, Lisp_Object * argv, int nargv,
547 Lisp_Object program, Lisp_Object cur_dir)
549 Lisp_Process *p = XPROCESS(process);
552 /* *_create_process may change status_symbol, if the process
553 is a kind of "fire-and-forget" (no I/O, unwaitable) */
554 p->status_symbol = Qrun;
557 pid = PROCMETH(create_process, (p, argv, nargv, program, cur_dir));
559 p->pid = make_int(pid);
560 if (PROCESS_READABLE_P(p))
561 event_stream_select_process(p);
564 /* This function is the unwind_protect form for Fstart_process_internal. If
565 PROCESS doesn't have its pid set, then we know someone has signalled
566 an error and the process wasn't started successfully, so we should
567 remove it from the process list. */
568 static void remove_process(Lisp_Object process);
569 static Lisp_Object start_process_unwind(Lisp_Object process)
571 /* Was PROCESS started successfully? */
572 if (EQ(XPROCESS(process)->pid, Qnil))
573 remove_process(process);
577 DEFUN("start-process-internal", Fstart_process_internal, 3, MANY, 0, /*
578 Start a program in a subprocess. Return the process object for it.
579 Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS
580 NAME is name for process. It is modified if necessary to make it unique.
581 BUFFER is the buffer or (buffer-name) to associate with the process.
582 Process output goes at end of that buffer, unless you specify
583 an output stream or filter function to handle the output.
584 BUFFER may be also nil, meaning that this process is not associated
586 Third arg is program file name. It is searched for as in the shell.
587 Remaining arguments are strings to give program as arguments.
588 If bound, `coding-system-for-read' and `coding-system-for-write' specify
589 the coding-system objects used in input from and output to the process.
591 (int nargs, Lisp_Object * args))
593 /* This function can call lisp */
594 /* !!#### This function has not been Mule-ized */
595 Lisp_Object buffer, name, program, process, current_dir;
598 int speccount = specpdl_depth();
599 struct gcpro gcpro1, gcpro2, gcpro3;
606 /* Protect against various file handlers doing GCs below. */
607 GCPRO3(buffer, program, current_dir);
610 buffer = Fget_buffer_create(buffer);
613 CHECK_STRING(program);
614 for (i = 3; i < nargs; ++i)
615 CHECK_STRING(args[i]);
617 /* Make sure that the child will be able to chdir to the current
618 buffer's current directory, or its unhandled equivalent. We
619 can't just have the child check for an error when it does the
620 chdir, since it's in a vfork.
622 Note: these assignments and calls are like this in order to insure
623 "caller protects args" GC semantics. */
624 current_dir = current_buffer->directory;
625 current_dir = Funhandled_file_name_directory(current_dir);
626 current_dir = expand_and_dir_to_file(current_dir, Qnil);
628 #if 0 /* This loser breaks ange-ftp */
629 /* dmoore - if you re-enable this code, you have to gcprotect
630 current_buffer through the above calls. */
631 if (NILP(Ffile_accessible_directory_p(current_dir)))
632 report_file_error("Setting current directory",
633 list1(current_buffer->directory));
636 /* If program file name is not absolute, search our path for it */
637 if (!IS_DIRECTORY_SEP(XSTRING_BYTE(program, 0))
638 && !(XSTRING_LENGTH(program) > 1
639 && IS_DEVICE_SEP(XSTRING_BYTE(program, 1)))) {
640 struct gcpro ngcpro1;
644 locate_file(Vexec_path, program, Vlisp_EXEC_SUFFIXES, &tem,
647 report_file_error("Searching for program",
649 program = Fexpand_file_name(tem, Qnil);
652 /* we still need to canonicalize it and ensure it has the proper
654 struct gcpro ngcpro1;
658 locate_file(list1(build_string("")), program,
659 Vlisp_EXEC_SUFFIXES, &tem, X_OK);
661 report_file_error("Searching for program",
667 if (!NILP(Ffile_directory_p(program)))
669 ("Specified program for new process is a directory",
672 process = make_process_internal(name);
674 XPROCESS(process)->buffer = buffer;
675 XPROCESS(process)->command = Flist(nargs - 2, args + 2);
677 /* Make the process marker point into the process buffer (if any). */
679 Fset_marker(XPROCESS(process)->mark,
680 make_int(BUF_ZV(XBUFFER(buffer))), buffer);
682 /* If an error occurs and we can't start the process, we want to
683 remove it from the process list. This means that each error
684 check in create_process doesn't need to call remove_process
685 itself; it's all taken care of here. */
686 record_unwind_protect(start_process_unwind, process);
688 create_process(process, args + 3, nargs - 3, program, current_dir);
691 return unbind_to(speccount, process);
696 /* #### The network support is fairly synthetical. What we actually
697 need is a single function, which supports all datagram, stream and
698 packet stream connections, arbitrary protocol families should they
699 be supported by the target system, multicast groups, in both data
700 and control rooted/nonrooted flavors, service quality etc whatever
701 is supported by the underlying network.
703 It must accept a property list describing the connection. The current
704 functions must then go to lisp and provide a suitable list for the
705 generalized connection function.
707 All modern UNIX other OSs support BSD sockets, and there are many
708 extensions available (Sockets 2 spec).
710 A todo is define a consistent set of properties abstracting a
711 network connection. -kkm
716 DEFUN("network-process-listener", Fnetwork_process_listener, 1, 1, 0, /*
717 Returns the process that listened and accepted the given
718 network-process. Returns nil if process is closed or was not accepted
719 through a network server stream.
723 PROCESS should be a network-stream process accepted through a network
728 CHECK_PROCESS(process);
729 return MAYBE_LISP_PROCMETH(network_process_listener, (process));
733 /* Listen for a TCP network connection to a given SERVICE. Treated
734 exactly like a normal process when reading and writing. Only
735 differences are in status display and process deletion. A network
736 connection has no PID; you cannot signal it. All you can do is
737 deactivate and close it via delete-process. You must provide a
739 DEFUN("open-network-server-stream-internal", Fopen_network_server_stream_internal, 4, 8, 0, /*
740 Returns a process object to represent the listening connection. When a
741 new connection request arrives, it is automatically accepted. A
742 network-stream process is automatically created for that
743 connection. If needed a new buffer is also created. If given the
744 acceptor function is called. If defined filter and sentinel are set
745 for the new connection process .
747 Input and output work as for subprocesses; `delete-process' closes it.
749 Args are NAME BUFFER HOST SERVICE &optional PROTOCOL ACCEPTOR .
751 NAME is name for process. It is modified if necessary to make it
754 BUFFER is the buffer (or buffer-name) to associate with the process.
755 Listening Process output goes at end of that buffer, unless you
756 specify an output stream or filter function to handle the output. No
757 real process output of listening process is expected. However the
758 name of this buffer will be used as a base for generating a new
759 buffer name for the accepted connections.
760 The BUFFER may be also nil, meaning that this process is not
761 associated with any buffer. In this case a filter should be specified
762 otherwise there will be no way to retrieve the process output.
763 BUFFER may also be 'auto in which case a buffer is automatically
764 created for the accepted connection.
766 Third arg HOST (a string) is the name of the IP to bind to, or its
767 IP address, If nil or ip_any will bind to all addresses on the
768 machine. When HOST is 'localhost listening connection will listen
769 to connections from the local machine only.
770 Fourth arg SERVICE is name of the service desired, or an integer
771 specifying a port number to connect to.
772 Fifth argument PROTOCOL is a network protocol. Currently 'tcp
773 (Transmission Control Protocol) and 'udp (User Datagram Protocol) are
774 supported. When omitted, 'tcp is assumed.
775 Sixt argument ACCEPTOR is a function which will be called upon connection
776 acceptance with the accepted connection process as the single argument.
777 Seventh argument FILTER is a function which will be set as filter for
778 the accepted connections automatically. See `set-process-filter' for
780 Eight argument SENTINEL is a function which will be set as sentinel
781 the accepted connections automatically. see `set-process-sentinel'
784 Output via `process-send-string' and input via buffer or filter (see
785 `set-process-filter') are stream-oriented. That means UDP datagrams are
786 not guaranteed to be sent and received in discrete packets. (But small
787 datagrams around 500 bytes that are not truncated by `process-send-string'
788 are usually fine.) Note further that UDP protocol does not guard against
791 In the ACCEPTOR you can use `network-process-listener' to get the original
792 listen process, and `process-buffer' to retrieve the associated
793 buffers. If sentinels and/or filters are set in the ACCEPTOR they
794 will override the FILTER and SENTINEL args to this function.
796 (name, buffer, host, service, protocol, acceptor, filter, sentinel))
799 /* !!#### This function has not been Mule-ized */
800 /* This function can GC */
801 Lisp_Object process = Qnil;
802 Lisp_Object bufname = Qnil;
803 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6, gcpro7, gcpro8, ngcpro1, ngcpro2;
806 GCPRO8(name, buffer, host, service, protocol, acceptor, filter, sentinel);
812 CHECK_SYMBOL(protocol);
817 /* Since this code is inside HAVE_SOCKETS, existence of
818 open_network_stream is mandatory */
819 PROCMETH(open_network_server_stream, (name, host, service, protocol,
822 NGCPRO2(process,bufname);
823 if (!NILP(buffer) && !SYMBOLP(buffer)) {
824 buffer = Fget_buffer_create(buffer);
825 bufname = Fbuffer_name(buffer);
826 } else if (SYMBOLP(buffer) && !NILP(buffer) && ! EQ(Qauto,buffer) ) {
827 error("unknown buffer symbol %s",
828 string_data(symbol_name(XSYMBOL(buffer))));
832 Lisp_Object args[] = {
833 build_string("<listen proc:%S host:%S service:%S protocol:%S>"),
834 name, host, service, protocol
836 bufname = Fformat( 5, args );
839 process = make_process_internal(name);
841 XPROCESS(process)->pid = Fcons(service, host);
842 XPROCESS(process)->process_type = PROCESS_TYPE_NETWORK_SERVER_LISTEN;
843 XPROCESS(process)->buffer = buffer;
845 /* Just opened a scope because I like to keep definitions close to
846 usage specially temporary ones... */
847 Lisp_Object args[] = { acceptor, filter, sentinel, bufname };
848 XPROCESS(process)->process_type_data = Flist(4,args);
850 init_process_io_handles(XPROCESS(process), (void *)inch, (void *)outch,
851 STREAM_NETWORK_SERVER_CONNECTION);
853 event_stream_select_process(XPROCESS(process));
861 /* open a TCP network connection to a given HOST/SERVICE. Treated
862 exactly like a normal process when reading and writing. Only
863 differences are in status display and process deletion. A network
864 connection has no PID; you cannot signal it. All you can do is
865 deactivate and close it via delete-process */
867 DEFUN("open-network-stream-internal", Fopen_network_stream_internal, 4, 5, 0, /*
868 Open a TCP connection for a service to a host.
869 Return a process object to represent the connection.
870 Input and output work as for subprocesses; `delete-process' closes it.
872 NAME is name for process. It is modified if necessary to make it unique.
873 BUFFER is the buffer (or buffer-name) to associate with the process.
874 Process output goes at end of that buffer, unless you specify
875 an output stream or filter function to handle the output.
876 BUFFER may also be nil, meaning that this process is not associated
878 Third arg HOST (a string) is the name of the host to connect to,
880 Fourth arg SERVICE is the name of the service desired (a string),
881 or an integer specifying a port number to connect to.
882 Optional fifth arg PROTOCOL is a network protocol. Currently only 'tcp
883 (Transmission Control Protocol) and 'udp (User Datagram Protocol) are
884 supported. When omitted, 'tcp is assumed.
886 Output via `process-send-string' and input via buffer or filter (see
887 `set-process-filter') are stream-oriented. That means UDP datagrams are
888 not guaranteed to be sent and received in discrete packets. (But small
889 datagrams around 500 bytes that are not truncated by `process-send-string'
890 are usually fine.) Note further that the UDP protocol does not guard
891 against lost packets.
893 (name, buffer, host, service, protocol))
895 /* !!#### This function has not been Mule-ized */
896 /* This function can GC */
897 Lisp_Object process = Qnil;
898 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, ngcpro1;
901 GCPRO5(name, buffer, host, service, protocol);
907 CHECK_SYMBOL(protocol);
909 /* Since this code is inside HAVE_SOCKETS, existence of
910 open_network_stream is mandatory */
911 PROCMETH(open_network_stream, (name, host, service, protocol,
915 buffer = Fget_buffer_create(buffer);
916 process = make_process_internal(name);
919 XPROCESS(process)->pid = Fcons(service, host);
920 XPROCESS(process)->process_type = PROCESS_TYPE_NETWORK;
921 XPROCESS(process)->buffer = buffer;
922 init_process_io_handles(XPROCESS(process), (void *)inch, (void *)outch,
923 STREAM_NETWORK_CONNECTION);
925 event_stream_select_process(XPROCESS(process));
932 DEFUN("connect-file-descriptor", Fconnect_file_descriptor, 4, 4, 0, /*
933 Connect to an existing file descriptor.
934 Return a subprocess-object to represent the connection.
935 Input and output work as for subprocesses; `delete-process' closes it.
936 Args are NAME BUFFER INFD OUTFD.
937 NAME is name for process. It is modified if necessary to make it unique.
938 BUFFER is the buffer (or buffer-name) to associate with the process.
939 Process output goes at end of that buffer, unless you specify
940 an output stream or filter function to handle the output.
941 BUFFER may also be nil, meaning that this process is not associated
943 INFD and OUTFD specify the file descriptors to use for input and
944 output, respectively.
946 (name, buffer, infd, outfd))
948 return connect_to_file_descriptor(name, buffer, infd, outfd);
951 #ifdef HAVE_MULTICAST
953 DEFUN("open-multicast-group-internal", Fopen_multicast_group_internal, 5, 5, 0, /*
954 Open a multicast connection on the specified dest/port/ttl.
955 Return a process object to represent the connection.
956 Input and output work as for subprocesses; `delete-process' closes it.
958 NAME is name for process. It is modified if necessary to make it unique.
959 BUFFER is the buffer (or buffer-name) to associate with the process.
960 Process output goes at end of that buffer, unless you specify
961 an output stream or filter function to handle the output.
962 BUFFER may also be nil, meaning that this process is not associated
964 Third, fourth and fifth args are the multicast destination group, port and ttl.
965 dest must be an internet address between 224.0.0.0 and 239.255.255.255
966 port is a communication port like in traditional unicast
967 ttl is the time-to-live (15 for site, 63 for region and 127 for world)
969 (name, buffer, dest, port, ttl))
971 /* !!#### This function has not been Mule-ized */
972 /* This function can GC */
973 Lisp_Object process = Qnil;
979 /* Since this code is inside HAVE_MULTICAST, existence of
980 open_network_stream is mandatory */
981 PROCMETH(open_multicast_group, (name, dest, port, ttl, &inch, &outch));
984 buffer = Fget_buffer_create(buffer);
986 process = make_process_internal(name);
989 XPROCESS(process)->pid = Fcons(port, dest);
990 XPROCESS(process)->process_type = PROCESS_TYPE_MULTICAST;
991 XPROCESS(process)->buffer = buffer;
992 init_process_io_handles(XPROCESS(process), (void *)inch, (void *)outch,
993 STREAM_NETWORK_CONNECTION);
995 event_stream_select_process(XPROCESS(process));
1000 #endif /* HAVE_MULTICAST */
1002 #endif /* HAVE_SOCKETS */
1004 Lisp_Object canonicalize_host_name(Lisp_Object host)
1006 return PROCMETH_OR_GIVEN(canonicalize_host_name, (host), host);
1009 DEFUN("set-process-window-size", Fset_process_window_size, 3, 3, 0, /*
1010 Tell PROCESS that it has logical window size HEIGHT and WIDTH.
1012 (process, height, width))
1014 CHECK_PROCESS(process);
1015 CHECK_NATNUM(height);
1016 CHECK_NATNUM(width);
1018 MAYBE_INT_PROCMETH(set_window_size,
1019 (XPROCESS(process), XINT(height),
1020 XINT(width))) <= 0 ? Qnil : Qt;
1023 /************************************************************************/
1025 /************************************************************************/
1027 /* Read pending output from the process channel,
1028 starting with our buffered-ahead character if we have one.
1029 Yield number of characters read.
1031 This function reads at most 1024 bytes.
1032 If you want to read all available subprocess output,
1033 you must call it repeatedly until it returns zero. */
1035 Charcount read_process_output(Lisp_Object process)
1037 /* This function can GC */
1038 Bytecount nbytes, nchars;
1039 Bufbyte chars[1024];
1040 Lisp_Object outstream;
1041 Lisp_Process *p = XPROCESS(process);
1043 /* If there is a lot of output from the subprocess, the loop in
1044 execute_internal_event() might call read_process_output() more
1045 than once. If the filter that was executed from one of these
1046 calls set the filter to t, we have to stop now. Return -1 rather
1047 than 0 so execute_internal_event() doesn't close the process.
1048 Really, the loop in execute_internal_event() should check itself
1049 for a process-filter change, like in status_notify(); but the
1050 struct Lisp_Process is not exported outside of this file. */
1051 if (!PROCESS_READABLE_P(p))
1052 return -1; /* already closed */
1054 if (!NILP(p->filter) && (p->filter_does_read)) {
1055 Lisp_Object filter_result;
1057 /* Some weird FSFmacs crap here with
1058 Vdeactivate_mark and current_buffer->keymap */
1059 running_asynch_code = 1;
1060 filter_result = call2_trapping_errors("Error in process filter",
1061 p->filter, process, Qnil);
1062 running_asynch_code = 0;
1063 restore_match_data();
1064 CHECK_INT(filter_result);
1065 return XINT(filter_result);
1068 switch (p->process_type) {
1069 case PROCESS_TYPE_NETWORK_SERVER_LISTEN:
1070 /* We must have add a connect... We should accept and call
1072 PROCMETH(network_server_accept, (wrap_object(p)));
1075 case PROCESS_TYPE_PROC:
1076 case PROCESS_TYPE_NETWORK:
1077 case PROCESS_TYPE_MULTICAST:
1078 case PROCESS_TYPE_SSL:
1080 nbytes = Lstream_read(XLSTREAM(DATA_INSTREAM(p)),
1081 chars, sizeof(chars));
1088 nchars = bytecount_to_charcount(chars, nbytes);
1089 outstream = p->filter;
1090 if (!NILP(outstream)) {
1091 /* We used to bind inhibit-quit to t here, but
1092 call2_trapping_errors() does that for us. */
1093 running_asynch_code = 1;
1094 call2_trapping_errors("Error in process filter",
1095 outstream, process, make_string(chars,
1097 running_asynch_code = 0;
1098 restore_match_data();
1102 /* If no filter, write into buffer if it isn't dead. */
1103 if (!NILP(p->buffer) && BUFFER_LIVE_P(XBUFFER(p->buffer))) {
1104 Lisp_Object old_read_only = Qnil;
1108 int old_zmacs_region_stays = zmacs_region_stays;
1109 struct gcpro gcpro1, gcpro2;
1110 struct buffer *buf = XBUFFER(p->buffer);
1112 GCPRO2(process, old_read_only);
1114 old_point = BUF_PT(buf);
1115 old_begv = BUF_BEGV(buf);
1116 old_zv = BUF_ZV(buf);
1117 old_read_only = buf->read_only;
1118 buf->read_only = Qnil;
1120 /* Insert new output into buffer
1121 at the current end-of-output marker,
1122 thus preserving logical ordering of input and output. */
1123 if (XMARKER(p->mark)->buffer)
1125 bufpos_clip_to_bounds(old_begv,
1130 BUF_SET_PT(buf, old_zv);
1132 /* If the output marker is outside of the visible region, save
1133 the restriction and widen. */
1134 if (!(BUF_BEGV(buf) <= BUF_PT(buf) &&
1135 BUF_PT(buf) <= BUF_ZV(buf)))
1138 /* Make sure opoint floats ahead of any new text, just as point
1140 if (BUF_PT(buf) <= old_point)
1141 old_point += nchars;
1143 /* Insert after old_begv, but before old_zv. */
1144 if (BUF_PT(buf) < old_begv)
1146 if (BUF_PT(buf) <= old_zv)
1150 /* This screws up initial display of the window. jla */
1152 /* Insert before markers in case we are inserting where
1153 the buffer's mark is, and the user's next command is Meta-y. */
1154 buffer_insert_raw_string_1(buf, -1, chars,
1155 nbytes, INSDEL_BEFORE_MARKERS);
1157 buffer_insert_raw_string(buf, chars, nbytes);
1160 Fset_marker(p->mark, make_int(BUF_PT(buf)), p->buffer);
1162 MARK_MODELINE_CHANGED;
1164 /* If the restriction isn't what it should be, set it. */
1165 if (old_begv != BUF_BEGV(buf) || old_zv != BUF_ZV(buf)) {
1167 old_begv = bufpos_clip_to_bounds(BUF_BEG(buf),
1168 old_begv, BUF_Z(buf));
1169 old_zv = bufpos_clip_to_bounds(BUF_BEG(buf),
1170 old_zv, BUF_Z(buf));
1171 Fnarrow_to_region(make_int(old_begv), make_int(old_zv),
1175 /* Handling the process output should not deactivate the mark. */
1176 zmacs_region_stays = old_zmacs_region_stays;
1177 buf->read_only = old_read_only;
1178 old_point = bufpos_clip_to_bounds(BUF_BEGV(buf),
1179 old_point, BUF_ZV(buf));
1180 BUF_SET_PT(buf, old_point);
1187 /* Sending data to subprocess */
1189 /* send some data to process PROCESS. If NONRELOCATABLE is non-NULL, it
1190 specifies the address of the data. Otherwise, the data comes from the
1191 object RELOCATABLE (either a string or a buffer). START and LEN
1192 specify the offset and length of the data to send.
1194 Note that START and LEN are in Bufpos's if RELOCATABLE is a buffer,
1195 and in Bytecounts otherwise. */
1198 send_process(Lisp_Object process,
1199 Lisp_Object relocatable, const Bufbyte * nonrelocatable,
1202 /* This function can GC */
1203 struct gcpro gcpro1, gcpro2;
1204 Lisp_Object lstream = Qnil;
1206 GCPRO2(process, lstream);
1208 if (NILP(DATA_OUTSTREAM(XPROCESS(process))))
1209 signal_simple_error("Process not open for writing", process);
1213 make_fixed_buffer_input_stream(nonrelocatable + start, len);
1214 else if (BUFFERP(relocatable))
1215 lstream = make_lisp_buffer_input_stream(XBUFFER(relocatable),
1216 start, start + len, 0);
1219 make_lisp_string_input_stream(relocatable, start, len);
1221 PROCMETH(send_process, (process, XLSTREAM(lstream)));
1224 Lstream_delete(XLSTREAM(lstream));
1227 DEFUN("process-tty-name", Fprocess_tty_name, 1, 1, 0, /*
1228 Return the name of the terminal PROCESS uses, or nil if none.
1229 This is the terminal that the process itself reads and writes on,
1230 not the name of the pty that Emacs uses to talk with that terminal.
1234 CHECK_PROCESS(process);
1235 return MAYBE_LISP_PROCMETH(get_tty_name, (XPROCESS(process)));
1238 DEFUN("set-process-buffer", Fset_process_buffer, 2, 2, 0, /*
1239 Set buffer associated with PROCESS to BUFFER (a buffer, or nil).
1243 CHECK_PROCESS(process);
1245 CHECK_BUFFER(buffer);
1246 XPROCESS(process)->buffer = buffer;
1250 DEFUN("process-buffer", Fprocess_buffer, 1, 1, 0, /*
1251 Return the buffer PROCESS is associated with.
1252 Output from PROCESS is inserted in this buffer
1253 unless PROCESS has a filter.
1257 CHECK_PROCESS(process);
1258 return XPROCESS(process)->buffer;
1261 DEFUN("process-mark", Fprocess_mark, 1, 1, 0, /*
1262 Return the marker for the end of the last output from PROCESS.
1266 CHECK_PROCESS(process);
1267 return XPROCESS(process)->mark;
1271 set_process_filter(Lisp_Object process, Lisp_Object filter,
1272 int filter_does_read)
1274 CHECK_PROCESS(process);
1275 if (PROCESS_READABLE_P(XPROCESS(process))) {
1277 event_stream_unselect_process(XPROCESS(process));
1279 event_stream_select_process(XPROCESS(process));
1282 XPROCESS(process)->filter = filter;
1283 XPROCESS(process)->filter_does_read = filter_does_read;
1286 DEFUN("set-process-filter", Fset_process_filter, 2, 3, 0, /*
1287 Give PROCESS the filter function FILTER; nil means no filter.
1288 t means stop accepting output from the process.
1289 When a process has a filter, each time it does output
1290 the entire string of output is passed to the filter.
1291 The filter gets two arguments: the process and the string of output
1292 unless third FILTER-DOES-READ parameter is non-nil. In that case
1293 output string is nil, and filter must perform reading by itself. It
1294 must return integer value of how much data was read, return 0 if there
1295 is nothing to be read.
1296 If the process has a filter, its buffer is not used for output.
1298 (process, filter, filter_does_read))
1300 set_process_filter(process, filter, !NILP(filter_does_read));
1304 DEFUN("process-filter", Fprocess_filter, 1, 1, 0, /*
1305 Return the filter function of PROCESS; nil if none.
1306 See `set-process-filter' for more info on filter functions.
1310 CHECK_PROCESS(process);
1311 return XPROCESS(process)->filter;
1314 DEFUN("process-type-data", Fprocess_type_data, 1, 1, 0, /*
1315 Return the type data of PROCESS; `nil' if none.
1319 CHECK_PROCESS(process);
1320 return XPROCESS(process)->process_type_data;
1323 DEFUN("process-send-region", Fprocess_send_region, 3, 4, 0, /*
1324 Send current contents of the region between START and END as input to PROCESS.
1325 PROCESS may be a process or the name of a process, or a buffer or the
1326 name of a buffer, in which case the buffer's process is used. If it
1327 is nil, the current buffer's process is used.
1328 BUFFER specifies the buffer to look in; if nil, the current buffer is used.
1329 If STRING is more than 100 or so characters long, it may be sent in
1330 several chunks. This may happen even for shorter strings. Output
1331 from processes can arrive in between chunks.
1333 (process, start, end, buffer))
1335 /* This function can GC */
1336 Bufpos bstart, bend;
1337 struct buffer *buf = decode_buffer(buffer, 0);
1339 XSETBUFFER(buffer, buf);
1340 process = get_process(process);
1341 get_buffer_range_char(buf, start, end, &bstart, &bend, 0);
1343 send_process(process, buffer, 0, bstart, bend - bstart);
1347 DEFUN("process-send-string", Fprocess_send_string, 2, 4, 0, /*
1348 Send PROCESS the contents of STRING as input.
1349 PROCESS may be a process or the name of a process, or a buffer or the
1350 name of a buffer, in which case the buffer's process is used. If it
1351 is nil, the current buffer's process is used.
1352 Optional arguments START and END specify part of STRING; see `substring'.
1353 If STRING is more than 100 or so characters long, it may be sent in
1354 several chunks. This may happen even for shorter strings. Output
1355 from processes can arrive in between chunks.
1357 (process, string, start, end))
1359 /* This function can GC */
1360 Bytecount bstart, bend;
1362 process = get_process(process);
1363 CHECK_STRING(string);
1364 get_string_range_byte(string, start, end, &bstart, &bend,
1365 GB_HISTORICAL_STRING_BEHAVIOR);
1367 send_process(process, string, 0, bstart, bend - bstart);
1373 DEFUN("process-input-coding-system", Fprocess_input_coding_system, 1, 1, 0, /*
1374 Return PROCESS's input coding system.
1378 process = get_process(process);
1379 CHECK_READABLE_PROCESS(process);
1381 decoding_stream_coding_system(XLSTREAM
1382 (XPROCESS(process)->coding_instream));
1385 DEFUN("process-output-coding-system", Fprocess_output_coding_system, 1, 1, 0, /*
1386 Return PROCESS's output coding system.
1390 process = get_process(process);
1391 CHECK_LIVE_PROCESS(process);
1393 encoding_stream_coding_system(XLSTREAM
1394 (XPROCESS(process)->
1398 DEFUN("process-coding-system", Fprocess_coding_system, 1, 1, 0, /*
1399 Return a pair of coding-system for decoding and encoding of PROCESS.
1403 process = get_process(process);
1404 CHECK_READABLE_PROCESS(process);
1405 return Fcons(decoding_stream_coding_system
1406 (XLSTREAM(XPROCESS(process)->coding_instream)),
1407 encoding_stream_coding_system
1408 (XLSTREAM(XPROCESS(process)->coding_outstream)));
1411 DEFUN("set-process-input-coding-system", Fset_process_input_coding_system, 2, 2, 0, /*
1412 Set PROCESS's input coding system to CODESYS.
1416 codesys = Fget_coding_system(codesys);
1417 process = get_process(process);
1418 CHECK_READABLE_PROCESS(process);
1420 set_decoding_stream_coding_system
1421 (XLSTREAM(XPROCESS(process)->coding_instream), codesys);
1425 DEFUN("set-process-output-coding-system",
1426 Fset_process_output_coding_system, 2, 2, 0, /*
1427 Set PROCESS's output coding system to CODESYS.
1431 codesys = Fget_coding_system(codesys);
1432 process = get_process(process);
1433 CHECK_LIVE_PROCESS(process);
1435 set_encoding_stream_coding_system
1436 (XLSTREAM(XPROCESS(process)->coding_outstream), codesys);
1440 DEFUN("set-process-coding-system", Fset_process_coding_system, 1, 3, 0, /*
1441 Set coding-systems of PROCESS to DECODING and ENCODING.
1442 DECODING will be used to decode subprocess output and ENCODING to
1443 encode subprocess input.
1445 (process, decoding, encoding))
1447 if (!NILP(decoding))
1448 Fset_process_input_coding_system(process, decoding);
1450 if (!NILP(encoding))
1451 Fset_process_output_coding_system(process, encoding);
1456 #endif /* FILE_CODING */
1458 /************************************************************************/
1459 /* process status */
1460 /************************************************************************/
1462 static Lisp_Object exec_sentinel_unwind(Lisp_Object datum)
1464 Lisp_Cons *d = XCONS(datum);
1465 XPROCESS(d->car)->sentinel = d->cdr;
1470 static void exec_sentinel(Lisp_Object process, Lisp_Object reason)
1472 /* This function can GC */
1473 int speccount = specpdl_depth();
1474 Lisp_Process *p = XPROCESS(process);
1475 Lisp_Object sentinel = p->sentinel;
1480 /* Some weird FSFmacs crap here with
1481 Vdeactivate_mark and current_buffer->keymap */
1483 /* Zilch the sentinel while it's running, to avoid recursive invocations;
1484 assure that it gets restored no matter how the sentinel exits. */
1486 record_unwind_protect(exec_sentinel_unwind,
1487 noseeum_cons(process, sentinel));
1488 /* We used to bind inhibit-quit to t here, but call2_trapping_errors()
1489 does that for us. */
1490 running_asynch_code = 1;
1491 call2_trapping_errors("Error in process sentinel", sentinel, process,
1493 running_asynch_code = 0;
1494 restore_match_data();
1495 unbind_to(speccount, Qnil);
1498 DEFUN("set-process-sentinel", Fset_process_sentinel, 2, 2, 0, /*
1499 Give PROCESS the sentinel SENTINEL; nil for none.
1500 The sentinel is called as a function when the process changes state.
1501 It gets two arguments: the process, and a string describing the change.
1503 (process, sentinel))
1505 CHECK_PROCESS(process);
1506 XPROCESS(process)->sentinel = sentinel;
1510 DEFUN("process-sentinel", Fprocess_sentinel, 1, 1, 0, /*
1511 Return the sentinel of PROCESS; nil if none.
1512 See `set-process-sentinel' for more info on sentinels.
1516 CHECK_PROCESS(process);
1517 return XPROCESS(process)->sentinel;
1520 const char *signal_name(int signum)
1522 if (signum >= 0 && signum < NSIG)
1524 return (const char *)strsignal(signum);
1525 #elif SXE_SYS_SIGLIST_DECLARED || HAVE_SYS_SIGLIST || SYS_SIGLIST_DECLARED || HAVE_DECL_SYS_SIGLIST
1526 return (const char *)sys_siglist[signum];
1528 return (const char *)GETTEXT("unknown signal - missing signal list");
1531 return (const char *)GETTEXT("unknown signal");
1535 update_process_status(Lisp_Object p,
1536 Lisp_Object status_symbol, int exit_code, int core_dumped)
1538 XPROCESS(p)->tick++;
1540 XPROCESS(p)->status_symbol = status_symbol;
1541 XPROCESS(p)->exit_code = exit_code;
1542 XPROCESS(p)->core_dumped = core_dumped;
1545 /* Return a string describing a process status list. */
1547 static Lisp_Object status_message(Lisp_Process * p)
1549 Lisp_Object symbol = p->status_symbol;
1550 int code = p->exit_code;
1551 int coredump = p->core_dumped;
1552 Lisp_Object string, string2;
1554 if (EQ(symbol, Qsignal) || EQ(symbol, Qstop)) {
1555 string = build_string(signal_name(code));
1557 string2 = build_translated_string(" (core dumped)\n");
1559 string2 = build_string("\n");
1560 set_string_char(XSTRING(string), 0,
1561 DOWNCASE(current_buffer,
1562 string_char(XSTRING(string), 0)));
1563 return concat2(string, string2);
1564 } else if (EQ(symbol, Qexit)) {
1566 return build_translated_string("finished\n");
1567 string = Fnumber_to_string(make_int(code));
1569 string2 = build_translated_string(" (core dumped)\n");
1571 string2 = build_string("\n");
1573 concat2(build_translated_string
1574 ("exited abnormally with code "), concat2(string,
1577 return Fcopy_sequence(Fsymbol_name(symbol));
1580 /* Tell status_notify() to check for terminated processes. We do this
1581 because on some systems we sometimes miss SIGCHLD calls. (Not sure
1584 void kick_status_notify(void)
1589 /* Report all recent events of a change in process status
1590 (either run the sentinel or output a message).
1591 This is done while Emacs is waiting for keyboard input. */
1593 void status_notify(void)
1595 /* This function can GC */
1596 Lisp_Object tail = Qnil;
1597 Lisp_Object symbol = Qnil;
1598 Lisp_Object msg = Qnil;
1599 struct gcpro gcpro1, gcpro2, gcpro3;
1600 /* process_tick is volatile, so we have to remember it now.
1601 Otherwise, we get a race condition if SIGCHLD happens during
1604 (Actually, this is not the case anymore. The code to
1605 update the process structures has been moved out of the
1606 SIGCHLD handler. But for the moment I'm leaving this
1607 stuff in -- it can't hurt.) */
1608 int temp_process_tick;
1610 MAYBE_PROCMETH(reap_exited_processes, ());
1612 temp_process_tick = process_tick;
1614 if (update_tick == temp_process_tick)
1617 /* We need to gcpro tail; if read_process_output calls a filter
1618 which deletes a process and removes the cons to which tail points
1619 from Vprocess_alist, and then causes a GC, tail is an unprotected
1621 GCPRO3(tail, symbol, msg);
1623 for (tail = Vprocess_list; CONSP(tail); tail = XCDR(tail)) {
1624 Lisp_Object process = XCAR(tail);
1625 Lisp_Process *p = XPROCESS(process);
1626 /* p->tick is also volatile. Same thing as above applies. */
1627 int this_process_tick;
1629 /* #### extra check for terminated processes, in case a SIGCHLD
1630 got missed (this seems to happen sometimes, I'm not sure why).
1633 MAYBE_PROCMETH(update_status_if_terminated, (p));
1635 this_process_tick = p->tick;
1636 if (this_process_tick != p->update_tick) {
1637 p->update_tick = this_process_tick;
1639 /* If process is still active, read any output that remains. */
1640 while (!EQ(p->filter, Qt)
1641 && read_process_output(process) > 0) ;
1643 /* Get the text to use for the message. */
1644 msg = status_message(p);
1646 /* If process is terminated, deactivate it or delete it. */
1647 symbol = p->status_symbol;
1649 if (EQ(symbol, Qsignal)
1650 || EQ(symbol, Qexit)) {
1651 if (delete_exited_processes)
1652 remove_process(process);
1654 deactivate_process(process);
1657 /* Now output the message suitably. */
1658 if (!NILP(p->sentinel))
1659 exec_sentinel(process, msg);
1660 /* Don't bother with a message in the buffer
1661 when a process becomes runnable. */
1662 else if (!EQ(symbol, Qrun) && !NILP(p->buffer)) {
1663 Lisp_Object old_read_only = Qnil;
1664 Lisp_Object old = Fcurrent_buffer();
1666 struct gcpro ngcpro1, ngcpro2;
1668 /* Avoid error if buffer is deleted
1669 (probably that's why the process is dead, too) */
1670 if (!BUFFER_LIVE_P(XBUFFER(p->buffer)))
1673 NGCPRO2(old, old_read_only);
1674 Fset_buffer(p->buffer);
1675 opoint = BUF_PT(current_buffer);
1676 /* Insert new output into buffer
1677 at the current end-of-output marker,
1678 thus preserving logical ordering of input and output. */
1679 if (XMARKER(p->mark)->buffer)
1680 BUF_SET_PT(current_buffer,
1681 marker_position(p->mark));
1683 BUF_SET_PT(current_buffer,
1684 BUF_ZV(current_buffer));
1685 if (BUF_PT(current_buffer) <= opoint)
1687 (string_char_length(XSTRING(msg))
1689 string_char_length(XSTRING
1693 old_read_only = current_buffer->read_only;
1694 current_buffer->read_only = Qnil;
1695 buffer_insert_c_string(current_buffer,
1697 Finsert(1, &p->name);
1698 buffer_insert_c_string(current_buffer, " ");
1700 current_buffer->read_only = old_read_only;
1701 Fset_marker(p->mark,
1702 make_int(BUF_PT(current_buffer)),
1706 bufpos_clip_to_bounds(BUF_BEGV
1707 (XBUFFER(p->buffer)),
1711 BUF_SET_PT(current_buffer, opoint);
1718 /* in case buffers use %s in modeline-format */
1719 MARK_MODELINE_CHANGED;
1722 update_tick = temp_process_tick;
1727 DEFUN("process-status", Fprocess_status, 1, 1, 0, /*
1728 Return the status of PROCESS.
1729 This is a symbol, one of these:
1731 run -- for a process that is running.
1732 stop -- for a process stopped but continuable.
1733 exit -- for a process that has exited.
1734 signal -- for a process that has got a fatal signal.
1735 open -- for a network stream connection that is open.
1736 closed -- for a network stream connection that is closed.
1737 nil -- if arg is a process name and no such process exists.
1739 PROCESS may be a process, a buffer, the name of a process or buffer, or
1740 nil, indicating the current buffer's process.
1744 Lisp_Object status_symbol;
1746 if (STRINGP(process))
1747 process = Fget_process(process);
1749 process = get_process(process);
1754 status_symbol = XPROCESS(process)->status_symbol;
1755 if (network_connection_p(process)) {
1756 if (EQ(status_symbol, Qrun))
1757 status_symbol = Qopen;
1758 else if (EQ(status_symbol, Qexit))
1759 status_symbol = Qclosed;
1761 return status_symbol;
1764 DEFUN("process-exit-status", Fprocess_exit_status, 1, 1, 0, /*
1765 Return the exit status of PROCESS or the signal number that killed it.
1766 If PROCESS has not yet exited or died, return 0.
1770 CHECK_PROCESS(process);
1771 return make_int(XPROCESS(process)->exit_code);
1774 static int decode_signal(Lisp_Object signal_)
1777 return XINT(signal_);
1781 CHECK_SYMBOL(signal_);
1782 name = string_data(XSYMBOL(signal_)->name);
1784 #define handle_signal(sym) do { \
1785 if (!strcmp ((const char *) name, #sym)) \
1789 handle_signal(SIGINT); /* ANSI */
1790 handle_signal(SIGILL); /* ANSI */
1791 handle_signal(SIGABRT); /* ANSI */
1792 handle_signal(SIGFPE); /* ANSI */
1793 handle_signal(SIGSEGV); /* ANSI */
1794 handle_signal(SIGTERM); /* ANSI */
1797 handle_signal(SIGHUP); /* POSIX */
1800 handle_signal(SIGQUIT); /* POSIX */
1803 handle_signal(SIGTRAP); /* POSIX */
1806 handle_signal(SIGKILL); /* POSIX */
1809 handle_signal(SIGUSR1); /* POSIX */
1812 handle_signal(SIGUSR2); /* POSIX */
1815 handle_signal(SIGPIPE); /* POSIX */
1818 handle_signal(SIGALRM); /* POSIX */
1821 handle_signal(SIGCHLD); /* POSIX */
1824 handle_signal(SIGCONT); /* POSIX */
1827 handle_signal(SIGSTOP); /* POSIX */
1830 handle_signal(SIGTSTP); /* POSIX */
1833 handle_signal(SIGTTIN); /* POSIX */
1836 handle_signal(SIGTTOU); /* POSIX */
1840 handle_signal(SIGBUS); /* XPG5 */
1843 handle_signal(SIGPOLL); /* XPG5 */
1846 handle_signal(SIGPROF); /* XPG5 */
1849 handle_signal(SIGSYS); /* XPG5 */
1852 handle_signal(SIGURG); /* XPG5 */
1855 handle_signal(SIGXCPU); /* XPG5 */
1858 handle_signal(SIGXFSZ); /* XPG5 */
1861 handle_signal(SIGVTALRM); /* XPG5 */
1865 handle_signal(SIGIO); /* BSD 4.2 */
1868 handle_signal(SIGWINCH); /* BSD 4.3 */
1872 handle_signal(SIGEMT);
1875 handle_signal(SIGINFO);
1878 handle_signal(SIGHWE);
1881 handle_signal(SIGPRE);
1884 handle_signal(SIGUME);
1887 handle_signal(SIGDLK);
1890 handle_signal(SIGCPULIM);
1893 handle_signal(SIGIOT);
1896 handle_signal(SIGLOST);
1899 handle_signal(SIGSTKFLT);
1902 handle_signal(SIGUNUSED);
1905 handle_signal(SIGDANGER); /* AIX */
1908 handle_signal(SIGMSG);
1911 handle_signal(SIGSOUND);
1914 handle_signal(SIGRETRACT);
1917 handle_signal(SIGGRANT);
1920 handle_signal(SIGPWR);
1923 #undef handle_signal
1925 error("Undefined signal name %s", name);
1926 return 0; /* Unreached */
1930 /* Send signal number SIGNO to PROCESS.
1931 CURRENT-GROUP non-nil means send signal to the current
1932 foreground process group of the process's controlling terminal rather
1933 than to the process's own process group.
1934 This is used for various commands in shell mode.
1935 If NOMSG is zero, insert signal-announcements into process's buffers
1938 If we can, we try to signal PROCESS by sending control characters
1939 down the pty. This allows us to signal inferiors who have changed
1940 their uid, for which kill() would return an EPERM error, or to
1941 processes running on another computer through a remote login. */
1944 process_send_signal(Lisp_Object process, int signo,
1945 int current_group, int nomsg)
1947 /* This function can GC */
1948 process = get_process(process);
1950 if (network_connection_p(process))
1951 error("Network connection %s is not a subprocess",
1952 XSTRING_DATA(XPROCESS(process)->name));
1953 CHECK_LIVE_PROCESS(process);
1955 MAYBE_PROCMETH(kill_child_process,
1956 (process, signo, current_group, nomsg));
1959 DEFUN("process-send-signal", Fprocess_send_signal, 1, 3, 0, /*
1960 Send signal SIGNAL to process PROCESS.
1961 SIGNAL may be an integer, or a symbol naming a signal, like `SIGSEGV'.
1962 PROCESS may be a process, a buffer, the name of a process or buffer, or
1963 nil, indicating the current buffer's process.
1964 Third arg CURRENT-GROUP non-nil means send signal to the current
1965 foreground process group of the process's controlling terminal rather
1966 than to the process's own process group.
1967 If the process is a shell that supports job control, this means
1968 send the signal to the current subjob rather than the shell.
1970 (signal_, process, current_group))
1972 /* This function can GC */
1973 process_send_signal(process, decode_signal(signal_),
1974 !NILP(current_group), 0);
1978 DEFUN("interrupt-process", Finterrupt_process, 0, 2, 0, /*
1979 Interrupt process PROCESS.
1980 See function `process-send-signal' for more details on usage.
1982 (process, current_group))
1984 /* This function can GC */
1985 process_send_signal(process, SIGINT, !NILP(current_group), 0);
1989 DEFUN("kill-process", Fkill_process, 0, 2, 0, /*
1990 Kill process PROCESS.
1991 See function `process-send-signal' for more details on usage.
1993 (process, current_group))
1995 /* This function can GC */
1997 process_send_signal(process, SIGKILL, !NILP(current_group), 0);
1999 error("kill-process: Not supported on this system");
2004 DEFUN("quit-process", Fquit_process, 0, 2, 0, /*
2005 Send QUIT signal to process PROCESS.
2006 See function `process-send-signal' for more details on usage.
2008 (process, current_group))
2010 /* This function can GC */
2012 process_send_signal(process, SIGQUIT, !NILP(current_group), 0);
2014 error("quit-process: Not supported on this system");
2019 DEFUN("stop-process", Fstop_process, 0, 2, 0, /*
2020 Stop process PROCESS.
2021 See function `process-send-signal' for more details on usage.
2023 (process, current_group))
2025 /* This function can GC */
2027 process_send_signal(process, SIGTSTP, !NILP(current_group), 0);
2029 error("stop-process: Not supported on this system");
2034 DEFUN("continue-process", Fcontinue_process, 0, 2, 0, /*
2035 Continue process PROCESS.
2036 See function `process-send-signal' for more details on usage.
2038 (process, current_group))
2040 /* This function can GC */
2042 process_send_signal(process, SIGCONT, !NILP(current_group), 0);
2044 error("continue-process: Not supported on this system");
2049 DEFUN("signal-process", Fsignal_process, 2, 2, "nProcess number: \nnSignal code: ", /*
2050 Send the process with process id PID the signal with code SIGNAL.
2051 PID must be an integer. The process need not be a child of this Emacs.
2052 SIGNAL may be an integer, or a symbol naming a signal, like `SIGSEGV'.
2058 return make_int(PROCMETH_OR_GIVEN(kill_process_by_pid,
2059 (XINT(pid), decode_signal(signal_)),
2063 DEFUN("process-send-eof", Fprocess_send_eof, 0, 1, 0, /*
2064 Make PROCESS see end-of-file in its input.
2065 PROCESS may be a process, a buffer, the name of a process or buffer, or
2066 nil, indicating the current buffer's process.
2067 If PROCESS is a network connection, or is a process communicating
2068 through a pipe (as opposed to a pty), then you cannot send any more
2069 text to PROCESS after you call this function.
2073 /* This function can GC */
2074 process = get_process(process);
2076 /* Make sure the process is really alive. */
2077 if (!EQ(XPROCESS(process)->status_symbol, Qrun))
2078 error("Process %s not running",
2079 XSTRING_DATA(XPROCESS(process)->name));
2081 if (!MAYBE_INT_PROCMETH(process_send_eof, (process))) {
2082 if (!NILP(DATA_OUTSTREAM(XPROCESS(process)))) {
2083 Lstream_close(XLSTREAM
2084 (DATA_OUTSTREAM(XPROCESS(process))));
2085 event_stream_delete_stream_pair(Qnil,
2088 XPROCESS(process)->pipe_outstream = Qnil;
2090 XPROCESS(process)->coding_outstream = Qnil;
2098 /************************************************************************/
2099 /* deleting a process */
2100 /************************************************************************/
2102 void deactivate_process(Lisp_Object process)
2104 Lisp_Process *p = XPROCESS(process);
2107 /* It's possible that we got as far in the process-creation
2108 process as creating the descriptors but didn't get so
2109 far as selecting the process for input. In this
2110 case, p->pid is nil: p->pid is set at the same time that
2111 the process is selected for input. */
2112 /* #### The comment does not look correct. event_stream_unselect_process
2113 is guarded by process->selected, so this is not a problem. - kkm */
2114 /* Must call this before setting the streams to nil */
2115 event_stream_unselect_process(p);
2117 if (!NILP(DATA_OUTSTREAM(p)))
2118 Lstream_close(XLSTREAM(DATA_OUTSTREAM(p)));
2119 if (!NILP(DATA_INSTREAM(p)))
2120 Lstream_close(XLSTREAM(DATA_INSTREAM(p)));
2122 /* Provide minimal implementation for deactivate_process
2123 if there's no process-specific one */
2124 if (HAS_PROCMETH_P(deactivate_process))
2125 usid = PROCMETH(deactivate_process, (p));
2127 usid = event_stream_delete_stream_pair(p->pipe_instream,
2130 if (usid != USID_DONTHASH)
2131 remhash((const void *)usid, usid_to_process);
2133 p->pipe_instream = Qnil;
2134 p->pipe_outstream = Qnil;
2136 p->coding_instream = Qnil;
2137 p->coding_outstream = Qnil;
2141 static void remove_process(Lisp_Object process)
2143 Vprocess_list = delq_no_quit(process, Vprocess_list);
2144 Fset_marker(XPROCESS(process)->mark, Qnil, Qnil);
2146 deactivate_process(process);
2149 DEFUN("delete-process", Fdelete_process, 1, 1, 0, /*
2150 Delete PROCESS: kill it and forget about it immediately.
2151 PROCESS may be a process or the name of one, or a buffer name.
2155 /* This function can GC */
2157 process = get_process(process);
2158 p = XPROCESS(process);
2159 if (network_connection_p(process)) {
2160 p->status_symbol = Qexit;
2165 } else if (PROCESS_LIVE_P(p)) {
2166 Fkill_process(process, Qnil);
2167 /* Do this now, since remove_process will make sigchld_handler do nothing. */
2168 p->status_symbol = Qsignal;
2169 p->exit_code = SIGKILL;
2175 remove_process(process);
2179 /* Kill all processes associated with `buffer'.
2180 If `buffer' is nil, kill all processes */
2182 void kill_buffer_processes(Lisp_Object buffer)
2184 LIST_LOOP_2(process, Vprocess_list)
2185 if ((NILP(buffer) || EQ(XPROCESS(process)->buffer, buffer))) {
2186 if (network_connection_p(process))
2187 Fdelete_process(process);
2188 else if (PROCESS_LIVE_P(XPROCESS(process)))
2189 process_send_signal(process, SIGHUP, 0, 1);
2193 DEFUN("process-kill-without-query", Fprocess_kill_without_query, 1, 2, 0, /*
2194 Say no query needed if PROCESS is running when Emacs is exited.
2195 Optional second argument if non-nil says to require a query.
2196 Value is t if a query was formerly required.
2198 (process, require_query_p))
2202 CHECK_PROCESS(process);
2203 tem = XPROCESS(process)->kill_without_query;
2204 XPROCESS(process)->kill_without_query = NILP(require_query_p);
2206 return tem ? Qnil : Qt;
2209 DEFUN("process-kill-without-query-p", Fprocess_kill_without_query_p, 1, 1, 0, /*
2210 Return t if PROCESS will be killed without query when emacs is exited.
2214 CHECK_PROCESS(process);
2215 return XPROCESS(process)->kill_without_query ? Qt : Qnil;
2219 mark_usid_to_process(Lisp_Object obj)
2221 struct hash_table *ht = get_dynacat(obj);
2226 mark_object((Lisp_Object)ht->zero_entry);
2229 for (e = ht->harray, limit = e + ht->size; e < limit; e++) {
2231 mark_object((Lisp_Object)e->contents);
2235 /* This is not named init_process in order to avoid a conflict with NS 3.3 */
2236 void init_sxemacs_process(void)
2238 MAYBE_PROCMETH(init_process, ());
2240 Vprocess_list = Qnil;
2242 if (usid_to_process) {
2243 clrhash(usid_to_process);
2246 usid_to_process = make_hash_table(32);
2247 Vusid_to_process = make_dynacat(usid_to_process);
2248 set_dynacat_marker(Vusid_to_process, mark_usid_to_process);
2252 void syms_of_process(void)
2254 INIT_LRECORD_IMPLEMENTATION(process);
2256 defsymbol(&Qprocessp, "processp");
2257 defsymbol(&Qprocess_live_p, "process-live-p");
2259 /* see comment at Fprocess_readable_p */
2260 defsymbol(&Qprocess_readable_p, "process-readable-p");
2262 defsymbol(&Qrun, "run");
2263 defsymbol(&Qstop, "stop");
2264 defsymbol(&Qopen, "open");
2265 defsymbol(&Qclosed, "closed");
2267 defsymbol(&Qtcp, "tcp");
2268 defsymbol(&Qudp, "udp");
2270 #ifdef HAVE_MULTICAST
2271 defsymbol(&Qmulticast, "multicast"); /* Used for occasional warnings */
2275 DEFSUBR(Fprocess_live_p);
2277 /* see comment at Fprocess_readable_p */
2278 DEFSUBR(Fprocess_readable_p);
2280 DEFSUBR(Fget_process);
2281 DEFSUBR(Fget_buffer_process);
2282 DEFSUBR(Fdelete_process);
2283 DEFSUBR(Fprocess_status);
2284 DEFSUBR(Fprocess_exit_status);
2285 DEFSUBR(Fprocess_id);
2286 DEFSUBR(Fprocess_name);
2287 DEFSUBR(Fprocess_tty_name);
2288 DEFSUBR(Fprocess_command);
2289 DEFSUBR(Fset_process_buffer);
2290 DEFSUBR(Fprocess_buffer);
2291 DEFSUBR(Fprocess_mark);
2292 DEFSUBR(Fset_process_filter);
2293 DEFSUBR(Fprocess_filter);
2294 DEFSUBR(Fprocess_type_data);
2295 DEFSUBR(Fset_process_window_size);
2296 DEFSUBR(Fset_process_sentinel);
2297 DEFSUBR(Fprocess_sentinel);
2298 DEFSUBR(Fprocess_kill_without_query);
2299 DEFSUBR(Fprocess_kill_without_query_p);
2300 DEFSUBR(Fprocess_list);
2301 DEFSUBR(Fstart_process_internal);
2303 defsymbol(&Qip_any, "ip_any");
2304 defsymbol(&Qlocalhost, "localhost");
2305 DEFSUBR(Fopen_network_stream_internal);
2306 DEFSUBR(Fopen_network_server_stream_internal);
2307 DEFSUBR(Fnetwork_process_listener);
2308 #ifdef HAVE_MULTICAST
2309 DEFSUBR(Fopen_multicast_group_internal);
2310 #endif /* HAVE_MULTICAST */
2311 #endif /* HAVE_SOCKETS */
2312 DEFSUBR(Fconnect_file_descriptor);
2313 DEFSUBR(Fprocess_send_region);
2314 DEFSUBR(Fprocess_send_string);
2315 DEFSUBR(Fprocess_send_signal);
2316 DEFSUBR(Finterrupt_process);
2317 DEFSUBR(Fkill_process);
2318 DEFSUBR(Fquit_process);
2319 DEFSUBR(Fstop_process);
2320 DEFSUBR(Fcontinue_process);
2321 DEFSUBR(Fprocess_send_eof);
2322 DEFSUBR(Fsignal_process);
2323 /* DEFSUBR (Fprocess_connection); */
2325 DEFSUBR(Fprocess_input_coding_system);
2326 DEFSUBR(Fprocess_output_coding_system);
2327 DEFSUBR(Fset_process_input_coding_system);
2328 DEFSUBR(Fset_process_output_coding_system);
2329 DEFSUBR(Fprocess_coding_system);
2330 DEFSUBR(Fset_process_coding_system);
2331 #endif /* FILE_CODING */
2334 void vars_of_process(void)
2336 Fprovide(intern("subprocesses"));
2338 Fprovide(intern("network-streams"));
2339 #ifdef HAVE_MULTICAST
2340 Fprovide(intern("multicast"));
2341 #endif /* HAVE_MULTICAST */
2342 #endif /* HAVE_SOCKETS */
2343 staticpro(&Vprocess_list);
2344 staticpro(&Vusid_to_process);
2346 DEFVAR_BOOL("delete-exited-processes", &delete_exited_processes /*
2347 *Non-nil means delete processes immediately when they exit.
2348 nil means don't delete them until `list-processes' is run.
2351 delete_exited_processes = 1;
2353 DEFVAR_CONST_LISP("null-device", &Vnull_device /*
2354 Name of the null device, which differs from system to system.
2355 The null device is a filename that acts as a sink for arbitrary amounts of
2356 data, which is discarded, or as a source for a zero-length file.
2357 It is available on all the systems that we currently support, but with
2358 different names (typically either `/dev/null' or `nul').
2360 Note that there is also a /dev/zero on most modern Unix versions,
2361 which acts like /dev/null when used as a sink, but as a source it
2362 sends a non-ending stream of zero bytes. It's used most often along
2363 with memory-mapping. We don't provide a Lisp variable for this
2364 because the operations needing this are lower level than what ELisp
2365 programs typically do.
2367 Vnull_device = build_string(NULL_DEVICE);
2369 DEFVAR_LISP("process-connection-type", &Vprocess_connection_type /*
2370 Control type of device used to communicate with subprocesses.
2371 Values are nil to use a pipe, or t or `pty' to use a pty.
2372 The value has no effect if the system has no ptys or if all ptys are busy:
2373 then a pipe is used in any case.
2374 The value takes effect when `start-process' is called.
2376 Vprocess_connection_type = Qt;
2378 DEFVAR_BOOL("windowed-process-io", &windowed_process_io /*
2379 Enables input/output on standard handles of a windowed process.
2380 When this variable is nil (the default), SXEmacs does not attempt to read
2381 standard output handle of a windowed process. Instead, the process is
2382 immediately marked as exited immediately upon successful launching. This is
2383 done because normal windowed processes do not use standard I/O, as they are
2384 not connected to any console.
2386 When launching a specially crafted windowed process, which expects to be
2387 launched by SXEmacs, or by other program which pipes its standard input and
2388 output, this variable must be set to non-nil, in which case SXEmacs will
2389 treat this process just like a console process.
2391 NOTE: You should never set this variable, only bind it.
2393 Only Windows processes can be "windowed" or "console". This variable has no
2394 effect on UNIX processes, because all UNIX processes are "console".
2396 windowed_process_io = 0;
2398 #ifdef PROCESS_IO_BLOCKING
2399 DEFVAR_LISP("network-stream-blocking-port-list", &network_stream_blocking_port_list /*
2400 List of port numbers or port names to set a blocking I/O mode with connection.
2401 Nil value means to set a default(non-blocking) I/O mode.
2402 The value takes effect when `open-network-stream-internal' is called.
2404 network_stream_blocking_port_list = Qnil;
2405 #endif /* PROCESS_IO_BLOCKING */
2408 #endif /* not NO_SUBPROCESSES */