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 /* In the bad old days of tooltalk this would return non-0 if
267 * there was a tooltalk connection. So that really means that
268 * in 101 times out of 100 this would return 0 because nobody
269 * ever used tooltalk. It is possible that one day this might
270 * need some d-bus love. */
275 int network_connection_p(Lisp_Object process)
277 return CONSP(XPROCESS(process)->pid);
281 DEFUN("processp", Fprocessp, 1, 1, 0, /*
282 Return t if OBJECT is a process.
286 return PROCESSP(object) ? Qt : Qnil;
289 DEFUN("process-live-p", Fprocess_live_p, 1, 1, 0, /*
290 Return t if OBJECT is a process that is alive.
294 return PROCESSP(object) && PROCESS_LIVE_P(XPROCESS(object))
299 /* This is a reasonable definition for this new primitive. Kyle sez:
301 "The patch looks OK to me except for the creation and exporting of the
302 Fprocess_readable_p function. I don't think a new Lisp function
303 should be created until we know something actually needs it. If
304 we later want to give process-readable-p different semantics it
305 may be hard to do it and stay compatible with what we hastily
308 He's right, not yet. Let's discuss the semantics on XEmacs Design
309 before enabling this.
311 DEFUN("process-readable-p", Fprocess_readable_p, 1, 1, 0, /*
312 Return t if OBJECT is a process from which input may be available.
316 return PROCESSP(object) && PROCESS_READABLE_P(XPROCESS(object))
321 DEFUN("process-list", Fprocess_list, 0, 0, 0, /*
322 Return a list of all processes.
326 return Fcopy_sequence(Vprocess_list);
329 DEFUN("get-process", Fget_process, 1, 1, 0, /*
330 Return the process named PROCESS-NAME (a string), or nil if there is none.
331 PROCESS-NAME may also be a process; if so, the value is that process.
335 if (PROCESSP(process_name))
339 /* this only gets called during GC when emacs is going away as a result
340 of a signal or crash. */
341 CHECK_STRING(process_name);
344 LIST_LOOP_2(process, Vprocess_list)
346 (process_name, XPROCESS(process)->name, 0))
352 DEFUN("get-buffer-process", Fget_buffer_process, 1, 1, 0, /*
353 Return the (or, a) process associated with BUFFER.
354 BUFFER may be a buffer or the name of one.
360 buffer = Fget_buffer(buffer);
365 LIST_LOOP_2(process, Vprocess_list)
366 if (EQ(XPROCESS(process)->buffer, buffer))
372 /* This is how commands for the user decode process arguments. It
373 accepts a process, a process name, a buffer, a buffer name, or nil.
374 Buffers denote the first process in the buffer, and nil denotes the
377 static Lisp_Object get_process(Lisp_Object name)
382 /* #### Look more closely into translating process names. */
385 /* This may be called during a GC from process_send_signal() from
386 kill_buffer_processes() if emacs decides to abort(). */
389 else if (STRINGP(name)) {
390 Lisp_Object object = Fget_process(name);
391 if (PROCESSP(object))
394 buffer = Fget_buffer(name);
396 goto have_buffer_object;
398 error("Process %s does not exist", XSTRING_DATA(name));
399 } else if (NILP(name)) {
400 buffer = Fcurrent_buffer();
401 goto have_buffer_object;
402 } else if (BUFFERP(name)) {
407 process = Fget_buffer_process(buffer);
408 if (PROCESSP(process))
411 error("Buffer %s has no process",
412 XSTRING_DATA(XBUFFER(buffer)->name));
414 return get_process(Fsignal(Qwrong_type_argument,
417 ("process or buffer or nil"),
421 DEFUN("process-id", Fprocess_id, 1, 1, 0, /*
422 Return the process id of PROCESS.
423 This is the pid of the Unix process which PROCESS uses or talks to.
424 For a network connection, this value is a cons of
425 (foreign-network-port . foreign-host-name).
430 CHECK_PROCESS(process);
432 pid = XPROCESS(process)->pid;
433 if (network_connection_p(process))
435 return Fcons(Fcar(pid), Fcdr(pid));
440 DEFUN("process-name", Fprocess_name, 1, 1, 0, /*
441 Return the name of PROCESS, as a string.
442 This is the name of the program invoked in PROCESS,
443 possibly modified to make it unique among process names.
447 CHECK_PROCESS(process);
448 return XPROCESS(process)->name;
451 DEFUN("process-command", Fprocess_command, 1, 1, 0, /*
452 Return the command that was executed to start PROCESS.
453 This is a list of strings, the first string being the program executed
454 and the rest of the strings being the arguments given to it.
458 CHECK_PROCESS(process);
459 return XPROCESS(process)->command;
462 /************************************************************************/
463 /* creating a process */
464 /************************************************************************/
466 Lisp_Object make_process_internal(Lisp_Object name)
468 Lisp_Object val, name1;
470 Lisp_Process *p = alloc_lcrecord_type(Lisp_Process, &lrecord_process);
472 /* If name is already in use, modify it until it is unused. */
477 Lisp_Object tem = Fget_process(name1);
480 sz = snprintf(suffix, sizeof(suffix), "<%d>", i);
481 assert(sz>=0 && sz<sizeof(suffix));
482 name1 = concat2(name, build_string(suffix));
491 p->mark = Fmake_marker();
493 p->status_symbol = Qrun;
496 p->filter_does_read = 0;
497 p->kill_without_query = 0;
501 p->pipe_instream = Qnil;
502 p->pipe_outstream = Qnil;
504 p->coding_instream = Qnil;
505 p->coding_outstream = Qnil;
507 p->process_type = PROCESS_TYPE_PROC;
508 p->process_type_data = Qnil;
511 MAYBE_PROCMETH(alloc_process_data, (p));
515 Vprocess_list = Fcons(val, Vprocess_list);
519 void init_process_io_handles(Lisp_Process * p, void *in, void *out, int flags)
521 USID usid = event_stream_create_stream_pair(in, out,
526 if (usid == USID_ERROR)
527 report_file_error("Setting up communication with subprocess",
530 if (usid != USID_DONTHASH) {
531 Lisp_Object process = Qnil;
532 XSETPROCESS(process, p);
533 puthash((const void *)usid, LISP_TO_VOID(process),
537 MAYBE_PROCMETH(init_process_io_handles, (p, in, out, flags));
540 p->coding_instream = make_decoding_input_stream
541 (XLSTREAM(p->pipe_instream),
542 Fget_coding_system(Vcoding_system_for_read));
543 Lstream_set_character_mode(XLSTREAM(p->coding_instream));
544 p->coding_outstream = make_encoding_output_stream
545 (XLSTREAM(p->pipe_outstream),
546 Fget_coding_system(Vcoding_system_for_write));
547 /* CODE_CNTL (&out_state[outchannel]) |= CC_END; !!####
548 What's going on here? */
549 #endif /* FILE_CODING */
553 create_process(Lisp_Object process, Lisp_Object * argv, int nargv,
554 Lisp_Object program, Lisp_Object cur_dir)
556 Lisp_Process *p = XPROCESS(process);
559 /* *_create_process may change status_symbol, if the process
560 is a kind of "fire-and-forget" (no I/O, unwaitable) */
561 p->status_symbol = Qrun;
564 pid = PROCMETH(create_process, (p, argv, nargv, program, cur_dir));
566 p->pid = make_int(pid);
567 if (PROCESS_READABLE_P(p))
568 event_stream_select_process(p);
571 /* This function is the unwind_protect form for Fstart_process_internal. If
572 PROCESS doesn't have its pid set, then we know someone has signalled
573 an error and the process wasn't started successfully, so we should
574 remove it from the process list. */
575 static void remove_process(Lisp_Object process);
576 static Lisp_Object start_process_unwind(Lisp_Object process)
578 /* Was PROCESS started successfully? */
579 if (EQ(XPROCESS(process)->pid, Qnil))
580 remove_process(process);
584 DEFUN("start-process-internal", Fstart_process_internal, 3, MANY, 0, /*
585 Start a program in a subprocess. Return the process object for it.
586 Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS
587 NAME is name for process. It is modified if necessary to make it unique.
588 BUFFER is the buffer or (buffer-name) to associate with the process.
589 Process output goes at end of that buffer, unless you specify
590 an output stream or filter function to handle the output.
591 BUFFER may be also nil, meaning that this process is not associated
593 Third arg is program file name. It is searched for as in the shell.
594 Remaining arguments are strings to give program as arguments.
595 If bound, `coding-system-for-read' and `coding-system-for-write' specify
596 the coding-system objects used in input from and output to the process.
598 (int nargs, Lisp_Object * args))
600 /* This function can call lisp */
601 /* !!#### This function has not been Mule-ized */
602 Lisp_Object buffer, name, program, process, current_dir;
605 int speccount = specpdl_depth();
606 struct gcpro gcpro1, gcpro2, gcpro3;
613 /* Protect against various file handlers doing GCs below. */
614 GCPRO3(buffer, program, current_dir);
617 buffer = Fget_buffer_create(buffer);
620 CHECK_STRING(program);
621 for (i = 3; i < nargs; ++i)
622 CHECK_STRING(args[i]);
624 /* Make sure that the child will be able to chdir to the current
625 buffer's current directory, or its unhandled equivalent. We
626 can't just have the child check for an error when it does the
627 chdir, since it's in a vfork.
629 Note: these assignments and calls are like this in order to insure
630 "caller protects args" GC semantics. */
631 current_dir = current_buffer->directory;
632 current_dir = Funhandled_file_name_directory(current_dir);
633 current_dir = expand_and_dir_to_file(current_dir, Qnil);
635 #if 0 /* This loser breaks ange-ftp */
636 /* dmoore - if you re-enable this code, you have to gcprotect
637 current_buffer through the above calls. */
638 if (NILP(Ffile_accessible_directory_p(current_dir)))
639 report_file_error("Setting current directory",
640 list1(current_buffer->directory));
643 /* If program file name is not absolute, search our path for it */
644 if (!IS_DIRECTORY_SEP(XSTRING_BYTE(program, 0))
645 && !(XSTRING_LENGTH(program) > 1
646 && IS_DEVICE_SEP(XSTRING_BYTE(program, 1)))) {
647 struct gcpro ngcpro1;
651 locate_file(Vexec_path, program, Vlisp_EXEC_SUFFIXES, &tem,
654 report_file_error("Searching for program",
656 program = Fexpand_file_name(tem, Qnil);
659 /* we still need to canonicalize it and ensure it has the proper
661 struct gcpro ngcpro1;
665 locate_file(list1(build_string("")), program,
666 Vlisp_EXEC_SUFFIXES, &tem, X_OK);
668 report_file_error("Searching for program",
674 if (!NILP(Ffile_directory_p(program)))
676 ("Specified program for new process is a directory",
679 process = make_process_internal(name);
681 XPROCESS(process)->buffer = buffer;
682 XPROCESS(process)->command = Flist(nargs - 2, args + 2);
684 /* Make the process marker point into the process buffer (if any). */
686 Fset_marker(XPROCESS(process)->mark,
687 make_int(BUF_ZV(XBUFFER(buffer))), buffer);
689 /* If an error occurs and we can't start the process, we want to
690 remove it from the process list. This means that each error
691 check in create_process doesn't need to call remove_process
692 itself; it's all taken care of here. */
693 record_unwind_protect(start_process_unwind, process);
695 create_process(process, args + 3, nargs - 3, program, current_dir);
698 return unbind_to(speccount, process);
703 /* #### The network support is fairly synthetical. What we actually
704 need is a single function, which supports all datagram, stream and
705 packet stream connections, arbitrary protocol families should they
706 be supported by the target system, multicast groups, in both data
707 and control rooted/nonrooted flavors, service quality etc whatever
708 is supported by the underlying network.
710 It must accept a property list describing the connection. The current
711 functions must then go to lisp and provide a suitable list for the
712 generalized connection function.
714 All modern UNIX other OSs support BSD sockets, and there are many
715 extensions available (Sockets 2 spec).
717 A todo is define a consistent set of properties abstracting a
718 network connection. -kkm
723 DEFUN("network-process-listener", Fnetwork_process_listener, 1, 1, 0, /*
724 Returns the process that listened and accepted the given
725 network-process. Returns nil if process is closed or was not accepted
726 through a network server stream.
730 PROCESS should be a network-stream process accepted through a network
735 CHECK_PROCESS(process);
736 return MAYBE_LISP_PROCMETH(network_process_listener, (process));
740 /* Listen for a TCP network connection to a given SERVICE. Treated
741 exactly like a normal process when reading and writing. Only
742 differences are in status display and process deletion. A network
743 connection has no PID; you cannot signal it. All you can do is
744 deactivate and close it via delete-process. You must provide a
746 DEFUN("open-network-server-stream-internal", Fopen_network_server_stream_internal, 4, 8, 0, /*
747 Returns a process object to represent the listening connection. When a
748 new connection request arrives, it is automatically accepted. A
749 network-stream process is automatically created for that
750 connection. If needed a new buffer is also created. If given the
751 acceptor function is called. If defined filter and sentinel are set
752 for the new connection process .
754 Input and output work as for subprocesses; `delete-process' closes it.
756 Args are NAME BUFFER HOST SERVICE &optional PROTOCOL ACCEPTOR .
758 NAME is name for process. It is modified if necessary to make it
761 BUFFER is the buffer (or buffer-name) to associate with the process.
762 Listening Process output goes at end of that buffer, unless you
763 specify an output stream or filter function to handle the output. No
764 real process output of listening process is expected. However the
765 name of this buffer will be used as a base for generating a new
766 buffer name for the accepted connections.
767 The BUFFER may be also nil, meaning that this process is not
768 associated with any buffer. In this case a filter should be specified
769 otherwise there will be no way to retrieve the process output.
770 BUFFER may also be 'auto in which case a buffer is automatically
771 created for the accepted connection.
773 Third arg HOST (a string) is the name of the IP to bind to, or its
774 IP address, If nil or ip_any will bind to all addresses on the
775 machine. When HOST is 'localhost listening connection will listen
776 to connections from the local machine only.
777 Fourth arg SERVICE is name of the service desired, or an integer
778 specifying a port number to connect to.
779 Fifth argument PROTOCOL is a network protocol. Currently 'tcp
780 (Transmission Control Protocol) and 'udp (User Datagram Protocol) are
781 supported. When omitted, 'tcp is assumed.
782 Sixt argument ACCEPTOR is a function which will be called upon connection
783 acceptance with the accepted connection process as the single argument.
784 Seventh argument FILTER is a function which will be set as filter for
785 the accepted connections automatically. See `set-process-filter' for
787 Eight argument SENTINEL is a function which will be set as sentinel
788 the accepted connections automatically. see `set-process-sentinel'
791 Output via `process-send-string' and input via buffer or filter (see
792 `set-process-filter') are stream-oriented. That means UDP datagrams are
793 not guaranteed to be sent and received in discrete packets. (But small
794 datagrams around 500 bytes that are not truncated by `process-send-string'
795 are usually fine.) Note further that UDP protocol does not guard against
798 In the ACCEPTOR you can use `network-process-listener' to get the original
799 listen process, and `process-buffer' to retrieve the associated
800 buffers. If sentinels and/or filters are set in the ACCEPTOR they
801 will override the FILTER and SENTINEL args to this function.
803 (name, buffer, host, service, protocol, acceptor, filter, sentinel))
806 /* !!#### This function has not been Mule-ized */
807 /* This function can GC */
808 Lisp_Object process = Qnil;
809 Lisp_Object bufname = Qnil;
810 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6, gcpro7, gcpro8, ngcpro1, ngcpro2;
813 GCPRO8(name, buffer, host, service, protocol, acceptor, filter, sentinel);
819 CHECK_SYMBOL(protocol);
824 /* Since this code is inside HAVE_SOCKETS, existence of
825 open_network_stream is mandatory */
826 PROCMETH(open_network_server_stream, (name, host, service, protocol,
829 NGCPRO2(process,bufname);
830 if (!NILP(buffer) && !SYMBOLP(buffer)) {
831 buffer = Fget_buffer_create(buffer);
832 bufname = Fbuffer_name(buffer);
833 } else if (SYMBOLP(buffer) && !NILP(buffer) && ! EQ(Qauto,buffer) ) {
834 error("unknown buffer symbol %s",
835 string_data(symbol_name(XSYMBOL(buffer))));
839 Lisp_Object args[] = {
840 build_string("<listen proc:%S host:%S service:%S protocol:%S>"),
841 name, host, service, protocol
843 bufname = Fformat( 5, args );
846 process = make_process_internal(name);
848 XPROCESS(process)->pid = Fcons(service, host);
849 XPROCESS(process)->process_type = PROCESS_TYPE_NETWORK_SERVER_LISTEN;
850 XPROCESS(process)->buffer = buffer;
852 /* Just opened a scope because I like to keep definitions close to
853 usage specially temporary ones... */
854 Lisp_Object args[] = { acceptor, filter, sentinel, bufname };
855 XPROCESS(process)->process_type_data = Flist(4,args);
857 init_process_io_handles(XPROCESS(process), (void *)inch, (void *)outch,
858 STREAM_NETWORK_SERVER_CONNECTION);
860 event_stream_select_process(XPROCESS(process));
868 /* open a TCP network connection to a given HOST/SERVICE. Treated
869 exactly like a normal process when reading and writing. Only
870 differences are in status display and process deletion. A network
871 connection has no PID; you cannot signal it. All you can do is
872 deactivate and close it via delete-process */
874 DEFUN("open-network-stream-internal", Fopen_network_stream_internal, 4, 5, 0, /*
875 Open a TCP connection for a service to a host.
876 Return a process object to represent the connection.
877 Input and output work as for subprocesses; `delete-process' closes it.
879 NAME is name for process. It is modified if necessary to make it unique.
880 BUFFER is the buffer (or buffer-name) to associate with the process.
881 Process output goes at end of that buffer, unless you specify
882 an output stream or filter function to handle the output.
883 BUFFER may also be nil, meaning that this process is not associated
885 Third arg HOST (a string) is the name of the host to connect to,
887 Fourth arg SERVICE is the name of the service desired (a string),
888 or an integer specifying a port number to connect to.
889 Optional fifth arg PROTOCOL is a network protocol. Currently only 'tcp
890 (Transmission Control Protocol) and 'udp (User Datagram Protocol) are
891 supported. When omitted, 'tcp is assumed.
893 Output via `process-send-string' and input via buffer or filter (see
894 `set-process-filter') are stream-oriented. That means UDP datagrams are
895 not guaranteed to be sent and received in discrete packets. (But small
896 datagrams around 500 bytes that are not truncated by `process-send-string'
897 are usually fine.) Note further that the UDP protocol does not guard
898 against lost packets.
900 (name, buffer, host, service, protocol))
902 /* !!#### This function has not been Mule-ized */
903 /* This function can GC */
904 Lisp_Object process = Qnil;
905 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, ngcpro1;
908 GCPRO5(name, buffer, host, service, protocol);
914 CHECK_SYMBOL(protocol);
916 /* Since this code is inside HAVE_SOCKETS, existence of
917 open_network_stream is mandatory */
918 PROCMETH(open_network_stream, (name, host, service, protocol,
922 buffer = Fget_buffer_create(buffer);
923 process = make_process_internal(name);
926 XPROCESS(process)->pid = Fcons(service, host);
927 XPROCESS(process)->process_type = PROCESS_TYPE_NETWORK;
928 XPROCESS(process)->buffer = buffer;
929 init_process_io_handles(XPROCESS(process), (void *)inch, (void *)outch,
930 STREAM_NETWORK_CONNECTION);
932 event_stream_select_process(XPROCESS(process));
939 DEFUN("connect-file-descriptor", Fconnect_file_descriptor, 4, 4, 0, /*
940 Connect to an existing file descriptor.
941 Return a subprocess-object to represent the connection.
942 Input and output work as for subprocesses; `delete-process' closes it.
943 Args are NAME BUFFER INFD OUTFD.
944 NAME is name for process. It is modified if necessary to make it unique.
945 BUFFER is the buffer (or buffer-name) to associate with the process.
946 Process output goes at end of that buffer, unless you specify
947 an output stream or filter function to handle the output.
948 BUFFER may also be nil, meaning that this process is not associated
950 INFD and OUTFD specify the file descriptors to use for input and
951 output, respectively.
953 (name, buffer, infd, outfd))
955 return connect_to_file_descriptor(name, buffer, infd, outfd);
958 #ifdef HAVE_MULTICAST
960 DEFUN("open-multicast-group-internal", Fopen_multicast_group_internal, 5, 5, 0, /*
961 Open a multicast connection on the specified dest/port/ttl.
962 Return a process object to represent the connection.
963 Input and output work as for subprocesses; `delete-process' closes it.
965 NAME is name for process. It is modified if necessary to make it unique.
966 BUFFER is the buffer (or buffer-name) to associate with the process.
967 Process output goes at end of that buffer, unless you specify
968 an output stream or filter function to handle the output.
969 BUFFER may also be nil, meaning that this process is not associated
971 Third, fourth and fifth args are the multicast destination group, port and ttl.
972 dest must be an internet address between 224.0.0.0 and 239.255.255.255
973 port is a communication port like in traditional unicast
974 ttl is the time-to-live (15 for site, 63 for region and 127 for world)
976 (name, buffer, dest, port, ttl))
978 /* !!#### This function has not been Mule-ized */
979 /* This function can GC */
980 Lisp_Object process = Qnil;
986 /* Since this code is inside HAVE_MULTICAST, existence of
987 open_network_stream is mandatory */
988 PROCMETH(open_multicast_group, (name, dest, port, ttl, &inch, &outch));
991 buffer = Fget_buffer_create(buffer);
993 process = make_process_internal(name);
996 XPROCESS(process)->pid = Fcons(port, dest);
997 XPROCESS(process)->process_type = PROCESS_TYPE_MULTICAST;
998 XPROCESS(process)->buffer = buffer;
999 init_process_io_handles(XPROCESS(process), (void *)inch, (void *)outch,
1000 STREAM_NETWORK_CONNECTION);
1002 event_stream_select_process(XPROCESS(process));
1007 #endif /* HAVE_MULTICAST */
1009 #endif /* HAVE_SOCKETS */
1011 Lisp_Object canonicalize_host_name(Lisp_Object host)
1013 return PROCMETH_OR_GIVEN(canonicalize_host_name, (host), host);
1016 DEFUN("set-process-window-size", Fset_process_window_size, 3, 3, 0, /*
1017 Tell PROCESS that it has logical window size HEIGHT and WIDTH.
1019 (process, height, width))
1021 CHECK_PROCESS(process);
1022 CHECK_NATNUM(height);
1023 CHECK_NATNUM(width);
1025 MAYBE_INT_PROCMETH(set_window_size,
1026 (XPROCESS(process), XINT(height),
1027 XINT(width))) <= 0 ? Qnil : Qt;
1030 /************************************************************************/
1032 /************************************************************************/
1034 /* Read pending output from the process channel,
1035 starting with our buffered-ahead character if we have one.
1036 Yield number of characters read.
1038 This function reads at most 1024 bytes.
1039 If you want to read all available subprocess output,
1040 you must call it repeatedly until it returns zero. */
1042 Charcount read_process_output(Lisp_Object process)
1044 /* This function can GC */
1045 Bytecount nbytes, nchars;
1046 Bufbyte chars[1024];
1047 Lisp_Object outstream;
1048 Lisp_Process *p = XPROCESS(process);
1050 /* If there is a lot of output from the subprocess, the loop in
1051 execute_internal_event() might call read_process_output() more
1052 than once. If the filter that was executed from one of these
1053 calls set the filter to t, we have to stop now. Return -1 rather
1054 than 0 so execute_internal_event() doesn't close the process.
1055 Really, the loop in execute_internal_event() should check itself
1056 for a process-filter change, like in status_notify(); but the
1057 struct Lisp_Process is not exported outside of this file. */
1058 if (!PROCESS_READABLE_P(p))
1059 return -1; /* already closed */
1061 if (!NILP(p->filter) && (p->filter_does_read)) {
1062 Lisp_Object filter_result;
1064 /* Some weird FSFmacs crap here with
1065 Vdeactivate_mark and current_buffer->keymap */
1066 running_asynch_code = 1;
1067 filter_result = call2_trapping_errors("Error in process filter",
1068 p->filter, process, Qnil);
1069 running_asynch_code = 0;
1070 restore_match_data();
1071 CHECK_INT(filter_result);
1072 return XINT(filter_result);
1075 switch (p->process_type) {
1076 case PROCESS_TYPE_NETWORK_SERVER_LISTEN:
1077 /* We must have add a connect... We should accept and call
1079 PROCMETH(network_server_accept, (wrap_object(p)));
1082 case PROCESS_TYPE_PROC:
1083 case PROCESS_TYPE_NETWORK:
1084 case PROCESS_TYPE_MULTICAST:
1085 case PROCESS_TYPE_SSL:
1087 nbytes = Lstream_read(XLSTREAM(DATA_INSTREAM(p)),
1088 chars, sizeof(chars));
1095 nchars = bytecount_to_charcount(chars, nbytes);
1096 outstream = p->filter;
1097 if (!NILP(outstream)) {
1098 /* We used to bind inhibit-quit to t here, but
1099 call2_trapping_errors() does that for us. */
1100 running_asynch_code = 1;
1101 call2_trapping_errors("Error in process filter",
1102 outstream, process, make_string(chars,
1104 running_asynch_code = 0;
1105 restore_match_data();
1109 /* If no filter, write into buffer if it isn't dead. */
1110 if (!NILP(p->buffer) && BUFFER_LIVE_P(XBUFFER(p->buffer))) {
1111 Lisp_Object old_read_only = Qnil;
1115 int old_zmacs_region_stays = zmacs_region_stays;
1116 struct gcpro gcpro1, gcpro2;
1117 struct buffer *buf = XBUFFER(p->buffer);
1119 GCPRO2(process, old_read_only);
1121 old_point = BUF_PT(buf);
1122 old_begv = BUF_BEGV(buf);
1123 old_zv = BUF_ZV(buf);
1124 old_read_only = buf->read_only;
1125 buf->read_only = Qnil;
1127 /* Insert new output into buffer
1128 at the current end-of-output marker,
1129 thus preserving logical ordering of input and output. */
1130 if (XMARKER(p->mark)->buffer)
1132 bufpos_clip_to_bounds(old_begv,
1137 BUF_SET_PT(buf, old_zv);
1139 /* If the output marker is outside of the visible region, save
1140 the restriction and widen. */
1141 if (!(BUF_BEGV(buf) <= BUF_PT(buf) &&
1142 BUF_PT(buf) <= BUF_ZV(buf)))
1145 /* Make sure opoint floats ahead of any new text, just as point
1147 if (BUF_PT(buf) <= old_point)
1148 old_point += nchars;
1150 /* Insert after old_begv, but before old_zv. */
1151 if (BUF_PT(buf) < old_begv)
1153 if (BUF_PT(buf) <= old_zv)
1157 /* This screws up initial display of the window. jla */
1159 /* Insert before markers in case we are inserting where
1160 the buffer's mark is, and the user's next command is Meta-y. */
1161 buffer_insert_raw_string_1(buf, -1, chars,
1162 nbytes, INSDEL_BEFORE_MARKERS);
1164 buffer_insert_raw_string(buf, chars, nbytes);
1167 Fset_marker(p->mark, make_int(BUF_PT(buf)), p->buffer);
1169 MARK_MODELINE_CHANGED;
1171 /* If the restriction isn't what it should be, set it. */
1172 if (old_begv != BUF_BEGV(buf) || old_zv != BUF_ZV(buf)) {
1174 old_begv = bufpos_clip_to_bounds(BUF_BEG(buf),
1175 old_begv, BUF_Z(buf));
1176 old_zv = bufpos_clip_to_bounds(BUF_BEG(buf),
1177 old_zv, BUF_Z(buf));
1178 Fnarrow_to_region(make_int(old_begv), make_int(old_zv),
1182 /* Handling the process output should not deactivate the mark. */
1183 zmacs_region_stays = old_zmacs_region_stays;
1184 buf->read_only = old_read_only;
1185 old_point = bufpos_clip_to_bounds(BUF_BEGV(buf),
1186 old_point, BUF_ZV(buf));
1187 BUF_SET_PT(buf, old_point);
1194 /* Sending data to subprocess */
1196 /* send some data to process PROCESS. If NONRELOCATABLE is non-NULL, it
1197 specifies the address of the data. Otherwise, the data comes from the
1198 object RELOCATABLE (either a string or a buffer). START and LEN
1199 specify the offset and length of the data to send.
1201 Note that START and LEN are in Bufpos's if RELOCATABLE is a buffer,
1202 and in Bytecounts otherwise. */
1205 send_process(Lisp_Object process,
1206 Lisp_Object relocatable, const Bufbyte * nonrelocatable,
1209 /* This function can GC */
1210 struct gcpro gcpro1, gcpro2;
1211 Lisp_Object lstream = Qnil;
1213 GCPRO2(process, lstream);
1215 if (NILP(DATA_OUTSTREAM(XPROCESS(process))))
1216 signal_simple_error("Process not open for writing", process);
1220 make_fixed_buffer_input_stream(nonrelocatable + start, len);
1221 else if (BUFFERP(relocatable))
1222 lstream = make_lisp_buffer_input_stream(XBUFFER(relocatable),
1223 start, start + len, 0);
1226 make_lisp_string_input_stream(relocatable, start, len);
1228 PROCMETH(send_process, (process, XLSTREAM(lstream)));
1231 Lstream_delete(XLSTREAM(lstream));
1234 DEFUN("process-tty-name", Fprocess_tty_name, 1, 1, 0, /*
1235 Return the name of the terminal PROCESS uses, or nil if none.
1236 This is the terminal that the process itself reads and writes on,
1237 not the name of the pty that Emacs uses to talk with that terminal.
1241 CHECK_PROCESS(process);
1242 return MAYBE_LISP_PROCMETH(get_tty_name, (XPROCESS(process)));
1245 DEFUN("set-process-buffer", Fset_process_buffer, 2, 2, 0, /*
1246 Set buffer associated with PROCESS to BUFFER (a buffer, or nil).
1250 CHECK_PROCESS(process);
1252 CHECK_BUFFER(buffer);
1253 XPROCESS(process)->buffer = buffer;
1257 DEFUN("process-buffer", Fprocess_buffer, 1, 1, 0, /*
1258 Return the buffer PROCESS is associated with.
1259 Output from PROCESS is inserted in this buffer
1260 unless PROCESS has a filter.
1264 CHECK_PROCESS(process);
1265 return XPROCESS(process)->buffer;
1268 DEFUN("process-mark", Fprocess_mark, 1, 1, 0, /*
1269 Return the marker for the end of the last output from PROCESS.
1273 CHECK_PROCESS(process);
1274 return XPROCESS(process)->mark;
1278 set_process_filter(Lisp_Object process, Lisp_Object filter,
1279 int filter_does_read)
1281 CHECK_PROCESS(process);
1282 if (PROCESS_READABLE_P(XPROCESS(process))) {
1284 event_stream_unselect_process(XPROCESS(process));
1286 event_stream_select_process(XPROCESS(process));
1289 XPROCESS(process)->filter = filter;
1290 XPROCESS(process)->filter_does_read = filter_does_read;
1293 DEFUN("set-process-filter", Fset_process_filter, 2, 3, 0, /*
1294 Give PROCESS the filter function FILTER; nil means no filter.
1295 t means stop accepting output from the process.
1296 When a process has a filter, each time it does output
1297 the entire string of output is passed to the filter.
1298 The filter gets two arguments: the process and the string of output
1299 unless third FILTER-DOES-READ parameter is non-nil. In that case
1300 output string is nil, and filter must perform reading by itself. It
1301 must return integer value of how much data was read, return 0 if there
1302 is nothing to be read.
1303 If the process has a filter, its buffer is not used for output.
1305 (process, filter, filter_does_read))
1307 set_process_filter(process, filter, !NILP(filter_does_read));
1311 DEFUN("process-filter", Fprocess_filter, 1, 1, 0, /*
1312 Return the filter function of PROCESS; nil if none.
1313 See `set-process-filter' for more info on filter functions.
1317 CHECK_PROCESS(process);
1318 return XPROCESS(process)->filter;
1321 DEFUN("process-type-data", Fprocess_type_data, 1, 1, 0, /*
1322 Return the type data of PROCESS; `nil' if none.
1326 CHECK_PROCESS(process);
1327 return XPROCESS(process)->process_type_data;
1330 DEFUN("process-send-region", Fprocess_send_region, 3, 4, 0, /*
1331 Send current contents of the region between START and END as input to PROCESS.
1332 PROCESS may be a process or the name of a process, or a buffer or the
1333 name of a buffer, in which case the buffer's process is used. If it
1334 is nil, the current buffer's process is used.
1335 BUFFER specifies the buffer to look in; if nil, the current buffer is used.
1336 If STRING is more than 100 or so characters long, it may be sent in
1337 several chunks. This may happen even for shorter strings. Output
1338 from processes can arrive in between chunks.
1340 (process, start, end, buffer))
1342 /* This function can GC */
1343 Bufpos bstart, bend;
1344 struct buffer *buf = decode_buffer(buffer, 0);
1346 XSETBUFFER(buffer, buf);
1347 process = get_process(process);
1348 get_buffer_range_char(buf, start, end, &bstart, &bend, 0);
1350 send_process(process, buffer, 0, bstart, bend - bstart);
1354 DEFUN("process-send-string", Fprocess_send_string, 2, 4, 0, /*
1355 Send PROCESS the contents of STRING as input.
1356 PROCESS may be a process or the name of a process, or a buffer or the
1357 name of a buffer, in which case the buffer's process is used. If it
1358 is nil, the current buffer's process is used.
1359 Optional arguments START and END specify part of STRING; see `substring'.
1360 If STRING is more than 100 or so characters long, it may be sent in
1361 several chunks. This may happen even for shorter strings. Output
1362 from processes can arrive in between chunks.
1364 (process, string, start, end))
1366 /* This function can GC */
1367 Bytecount bstart, bend;
1369 process = get_process(process);
1370 CHECK_STRING(string);
1371 get_string_range_byte(string, start, end, &bstart, &bend,
1372 GB_HISTORICAL_STRING_BEHAVIOR);
1374 send_process(process, string, 0, bstart, bend - bstart);
1380 DEFUN("process-input-coding-system", Fprocess_input_coding_system, 1, 1, 0, /*
1381 Return PROCESS's input coding system.
1385 process = get_process(process);
1386 CHECK_READABLE_PROCESS(process);
1388 decoding_stream_coding_system(XLSTREAM
1389 (XPROCESS(process)->coding_instream));
1392 DEFUN("process-output-coding-system", Fprocess_output_coding_system, 1, 1, 0, /*
1393 Return PROCESS's output coding system.
1397 process = get_process(process);
1398 CHECK_LIVE_PROCESS(process);
1400 encoding_stream_coding_system(XLSTREAM
1401 (XPROCESS(process)->
1405 DEFUN("process-coding-system", Fprocess_coding_system, 1, 1, 0, /*
1406 Return a pair of coding-system for decoding and encoding of PROCESS.
1410 process = get_process(process);
1411 CHECK_READABLE_PROCESS(process);
1412 return Fcons(decoding_stream_coding_system
1413 (XLSTREAM(XPROCESS(process)->coding_instream)),
1414 encoding_stream_coding_system
1415 (XLSTREAM(XPROCESS(process)->coding_outstream)));
1418 DEFUN("set-process-input-coding-system", Fset_process_input_coding_system, 2, 2, 0, /*
1419 Set PROCESS's input coding system to CODESYS.
1423 codesys = Fget_coding_system(codesys);
1424 process = get_process(process);
1425 CHECK_READABLE_PROCESS(process);
1427 set_decoding_stream_coding_system
1428 (XLSTREAM(XPROCESS(process)->coding_instream), codesys);
1432 DEFUN("set-process-output-coding-system",
1433 Fset_process_output_coding_system, 2, 2, 0, /*
1434 Set PROCESS's output coding system to CODESYS.
1438 codesys = Fget_coding_system(codesys);
1439 process = get_process(process);
1440 CHECK_LIVE_PROCESS(process);
1442 set_encoding_stream_coding_system
1443 (XLSTREAM(XPROCESS(process)->coding_outstream), codesys);
1447 DEFUN("set-process-coding-system", Fset_process_coding_system, 1, 3, 0, /*
1448 Set coding-systems of PROCESS to DECODING and ENCODING.
1449 DECODING will be used to decode subprocess output and ENCODING to
1450 encode subprocess input.
1452 (process, decoding, encoding))
1454 if (!NILP(decoding))
1455 Fset_process_input_coding_system(process, decoding);
1457 if (!NILP(encoding))
1458 Fset_process_output_coding_system(process, encoding);
1463 #endif /* FILE_CODING */
1465 /************************************************************************/
1466 /* process status */
1467 /************************************************************************/
1469 static Lisp_Object exec_sentinel_unwind(Lisp_Object datum)
1471 Lisp_Cons *d = XCONS(datum);
1472 XPROCESS(d->car)->sentinel = d->cdr;
1477 static void exec_sentinel(Lisp_Object process, Lisp_Object reason)
1479 /* This function can GC */
1480 int speccount = specpdl_depth();
1481 Lisp_Process *p = XPROCESS(process);
1482 Lisp_Object sentinel = p->sentinel;
1487 /* Some weird FSFmacs crap here with
1488 Vdeactivate_mark and current_buffer->keymap */
1490 /* Zilch the sentinel while it's running, to avoid recursive invocations;
1491 assure that it gets restored no matter how the sentinel exits. */
1493 record_unwind_protect(exec_sentinel_unwind,
1494 noseeum_cons(process, sentinel));
1495 /* We used to bind inhibit-quit to t here, but call2_trapping_errors()
1496 does that for us. */
1497 running_asynch_code = 1;
1498 call2_trapping_errors("Error in process sentinel", sentinel, process,
1500 running_asynch_code = 0;
1501 restore_match_data();
1502 unbind_to(speccount, Qnil);
1505 DEFUN("set-process-sentinel", Fset_process_sentinel, 2, 2, 0, /*
1506 Give PROCESS the sentinel SENTINEL; nil for none.
1507 The sentinel is called as a function when the process changes state.
1508 It gets two arguments: the process, and a string describing the change.
1510 (process, sentinel))
1512 CHECK_PROCESS(process);
1513 XPROCESS(process)->sentinel = sentinel;
1517 DEFUN("process-sentinel", Fprocess_sentinel, 1, 1, 0, /*
1518 Return the sentinel of PROCESS; nil if none.
1519 See `set-process-sentinel' for more info on sentinels.
1523 CHECK_PROCESS(process);
1524 return XPROCESS(process)->sentinel;
1527 const char *signal_name(int signum)
1529 if (signum >= 0 && signum < NSIG)
1531 return (const char *)strsignal(signum);
1532 #elif SXE_SYS_SIGLIST_DECLARED || HAVE_SYS_SIGLIST || SYS_SIGLIST_DECLARED || HAVE_DECL_SYS_SIGLIST
1533 return (const char *)sys_siglist[signum];
1535 return (const char *)GETTEXT("unknown signal - missing signal list");
1538 return (const char *)GETTEXT("unknown signal");
1542 update_process_status(Lisp_Object p,
1543 Lisp_Object status_symbol, int exit_code, int core_dumped)
1545 XPROCESS(p)->tick++;
1547 XPROCESS(p)->status_symbol = status_symbol;
1548 XPROCESS(p)->exit_code = exit_code;
1549 XPROCESS(p)->core_dumped = core_dumped;
1552 /* Return a string describing a process status list. */
1554 static Lisp_Object status_message(Lisp_Process * p)
1556 Lisp_Object symbol = p->status_symbol;
1557 int code = p->exit_code;
1558 int coredump = p->core_dumped;
1559 Lisp_Object string, string2;
1561 if (EQ(symbol, Qsignal) || EQ(symbol, Qstop)) {
1562 string = build_string(signal_name(code));
1564 string2 = build_translated_string(" (core dumped)\n");
1566 string2 = build_string("\n");
1567 set_string_char(XSTRING(string), 0,
1568 DOWNCASE(current_buffer,
1569 string_char(XSTRING(string), 0)));
1570 return concat2(string, string2);
1571 } else if (EQ(symbol, Qexit)) {
1573 return build_translated_string("finished\n");
1574 string = Fnumber_to_string(make_int(code));
1576 string2 = build_translated_string(" (core dumped)\n");
1578 string2 = build_string("\n");
1580 concat2(build_translated_string
1581 ("exited abnormally with code "), concat2(string,
1584 return Fcopy_sequence(Fsymbol_name(symbol));
1587 /* Tell status_notify() to check for terminated processes. We do this
1588 because on some systems we sometimes miss SIGCHLD calls. (Not sure
1591 void kick_status_notify(void)
1596 /* Report all recent events of a change in process status
1597 (either run the sentinel or output a message).
1598 This is done while Emacs is waiting for keyboard input. */
1600 void status_notify(void)
1602 /* This function can GC */
1603 Lisp_Object tail = Qnil;
1604 Lisp_Object symbol = Qnil;
1605 Lisp_Object msg = Qnil;
1606 struct gcpro gcpro1, gcpro2, gcpro3;
1607 /* process_tick is volatile, so we have to remember it now.
1608 Otherwise, we get a race condition if SIGCHLD happens during
1611 (Actually, this is not the case anymore. The code to
1612 update the process structures has been moved out of the
1613 SIGCHLD handler. But for the moment I'm leaving this
1614 stuff in -- it can't hurt.) */
1615 int temp_process_tick;
1617 MAYBE_PROCMETH(reap_exited_processes, ());
1619 temp_process_tick = process_tick;
1621 if (update_tick == temp_process_tick)
1624 /* We need to gcpro tail; if read_process_output calls a filter
1625 which deletes a process and removes the cons to which tail points
1626 from Vprocess_alist, and then causes a GC, tail is an unprotected
1628 GCPRO3(tail, symbol, msg);
1630 for (tail = Vprocess_list; CONSP(tail); tail = XCDR(tail)) {
1631 Lisp_Object process = XCAR(tail);
1632 Lisp_Process *p = XPROCESS(process);
1633 /* p->tick is also volatile. Same thing as above applies. */
1634 int this_process_tick;
1636 /* #### extra check for terminated processes, in case a SIGCHLD
1637 got missed (this seems to happen sometimes, I'm not sure why).
1640 MAYBE_PROCMETH(update_status_if_terminated, (p));
1642 this_process_tick = p->tick;
1643 if (this_process_tick != p->update_tick) {
1644 p->update_tick = this_process_tick;
1646 /* If process is still active, read any output that remains. */
1647 while (!EQ(p->filter, Qt)
1648 && read_process_output(process) > 0) ;
1650 /* Get the text to use for the message. */
1651 msg = status_message(p);
1653 /* If process is terminated, deactivate it or delete it. */
1654 symbol = p->status_symbol;
1656 if (EQ(symbol, Qsignal)
1657 || EQ(symbol, Qexit)) {
1658 if (delete_exited_processes)
1659 remove_process(process);
1661 deactivate_process(process);
1664 /* Now output the message suitably. */
1665 if (!NILP(p->sentinel))
1666 exec_sentinel(process, msg);
1667 /* Don't bother with a message in the buffer
1668 when a process becomes runnable. */
1669 else if (!EQ(symbol, Qrun) && !NILP(p->buffer)) {
1670 Lisp_Object old_read_only = Qnil;
1671 Lisp_Object old = Fcurrent_buffer();
1673 struct gcpro ngcpro1, ngcpro2;
1675 /* Avoid error if buffer is deleted
1676 (probably that's why the process is dead, too) */
1677 if (!BUFFER_LIVE_P(XBUFFER(p->buffer)))
1680 NGCPRO2(old, old_read_only);
1681 Fset_buffer(p->buffer);
1682 opoint = BUF_PT(current_buffer);
1683 /* Insert new output into buffer
1684 at the current end-of-output marker,
1685 thus preserving logical ordering of input and output. */
1686 if (XMARKER(p->mark)->buffer)
1687 BUF_SET_PT(current_buffer,
1688 marker_position(p->mark));
1690 BUF_SET_PT(current_buffer,
1691 BUF_ZV(current_buffer));
1692 if (BUF_PT(current_buffer) <= opoint)
1694 (string_char_length(XSTRING(msg))
1696 string_char_length(XSTRING
1700 old_read_only = current_buffer->read_only;
1701 current_buffer->read_only = Qnil;
1702 buffer_insert_c_string(current_buffer,
1704 Finsert(1, &p->name);
1705 buffer_insert_c_string(current_buffer, " ");
1707 current_buffer->read_only = old_read_only;
1708 Fset_marker(p->mark,
1709 make_int(BUF_PT(current_buffer)),
1713 bufpos_clip_to_bounds(BUF_BEGV
1714 (XBUFFER(p->buffer)),
1718 BUF_SET_PT(current_buffer, opoint);
1725 /* in case buffers use %s in modeline-format */
1726 MARK_MODELINE_CHANGED;
1729 update_tick = temp_process_tick;
1734 DEFUN("process-status", Fprocess_status, 1, 1, 0, /*
1735 Return the status of PROCESS.
1736 This is a symbol, one of these:
1738 run -- for a process that is running.
1739 stop -- for a process stopped but continuable.
1740 exit -- for a process that has exited.
1741 signal -- for a process that has got a fatal signal.
1742 open -- for a network stream connection that is open.
1743 closed -- for a network stream connection that is closed.
1744 nil -- if arg is a process name and no such process exists.
1746 PROCESS may be a process, a buffer, the name of a process or buffer, or
1747 nil, indicating the current buffer's process.
1751 Lisp_Object status_symbol;
1753 if (STRINGP(process))
1754 process = Fget_process(process);
1756 process = get_process(process);
1761 status_symbol = XPROCESS(process)->status_symbol;
1762 if (network_connection_p(process)) {
1763 if (EQ(status_symbol, Qrun))
1764 status_symbol = Qopen;
1765 else if (EQ(status_symbol, Qexit))
1766 status_symbol = Qclosed;
1768 return status_symbol;
1771 DEFUN("process-exit-status", Fprocess_exit_status, 1, 1, 0, /*
1772 Return the exit status of PROCESS or the signal number that killed it.
1773 If PROCESS has not yet exited or died, return 0.
1777 CHECK_PROCESS(process);
1778 return make_int(XPROCESS(process)->exit_code);
1781 static int decode_signal(Lisp_Object signal_)
1784 return XINT(signal_);
1788 CHECK_SYMBOL(signal_);
1789 name = string_data(XSYMBOL(signal_)->name);
1791 #define handle_signal(sym) do { \
1792 if (!strcmp ((const char *) name, #sym)) \
1796 handle_signal(SIGINT); /* ANSI */
1797 handle_signal(SIGILL); /* ANSI */
1798 handle_signal(SIGABRT); /* ANSI */
1799 handle_signal(SIGFPE); /* ANSI */
1800 handle_signal(SIGSEGV); /* ANSI */
1801 handle_signal(SIGTERM); /* ANSI */
1804 handle_signal(SIGHUP); /* POSIX */
1807 handle_signal(SIGQUIT); /* POSIX */
1810 handle_signal(SIGTRAP); /* POSIX */
1813 handle_signal(SIGKILL); /* POSIX */
1816 handle_signal(SIGUSR1); /* POSIX */
1819 handle_signal(SIGUSR2); /* POSIX */
1822 handle_signal(SIGPIPE); /* POSIX */
1825 handle_signal(SIGALRM); /* POSIX */
1828 handle_signal(SIGCHLD); /* POSIX */
1831 handle_signal(SIGCONT); /* POSIX */
1834 handle_signal(SIGSTOP); /* POSIX */
1837 handle_signal(SIGTSTP); /* POSIX */
1840 handle_signal(SIGTTIN); /* POSIX */
1843 handle_signal(SIGTTOU); /* POSIX */
1847 handle_signal(SIGBUS); /* XPG5 */
1850 handle_signal(SIGPOLL); /* XPG5 */
1853 handle_signal(SIGPROF); /* XPG5 */
1856 handle_signal(SIGSYS); /* XPG5 */
1859 handle_signal(SIGURG); /* XPG5 */
1862 handle_signal(SIGXCPU); /* XPG5 */
1865 handle_signal(SIGXFSZ); /* XPG5 */
1868 handle_signal(SIGVTALRM); /* XPG5 */
1872 handle_signal(SIGIO); /* BSD 4.2 */
1875 handle_signal(SIGWINCH); /* BSD 4.3 */
1879 handle_signal(SIGEMT);
1882 handle_signal(SIGINFO);
1885 handle_signal(SIGHWE);
1888 handle_signal(SIGPRE);
1891 handle_signal(SIGUME);
1894 handle_signal(SIGDLK);
1897 handle_signal(SIGCPULIM);
1900 handle_signal(SIGIOT);
1903 handle_signal(SIGLOST);
1906 handle_signal(SIGSTKFLT);
1909 handle_signal(SIGUNUSED);
1912 handle_signal(SIGDANGER); /* AIX */
1915 handle_signal(SIGMSG);
1918 handle_signal(SIGSOUND);
1921 handle_signal(SIGRETRACT);
1924 handle_signal(SIGGRANT);
1927 handle_signal(SIGPWR);
1930 #undef handle_signal
1932 error("Undefined signal name %s", name);
1933 return 0; /* Unreached */
1937 /* Send signal number SIGNO to PROCESS.
1938 CURRENT-GROUP non-nil means send signal to the current
1939 foreground process group of the process's controlling terminal rather
1940 than to the process's own process group.
1941 This is used for various commands in shell mode.
1942 If NOMSG is zero, insert signal-announcements into process's buffers
1945 If we can, we try to signal PROCESS by sending control characters
1946 down the pty. This allows us to signal inferiors who have changed
1947 their uid, for which kill() would return an EPERM error, or to
1948 processes running on another computer through a remote login. */
1951 process_send_signal(Lisp_Object process, int signo,
1952 int current_group, int nomsg)
1954 /* This function can GC */
1955 process = get_process(process);
1957 if (network_connection_p(process))
1958 error("Network connection %s is not a subprocess",
1959 XSTRING_DATA(XPROCESS(process)->name));
1960 CHECK_LIVE_PROCESS(process);
1962 MAYBE_PROCMETH(kill_child_process,
1963 (process, signo, current_group, nomsg));
1966 DEFUN("process-send-signal", Fprocess_send_signal, 1, 3, 0, /*
1967 Send signal SIGNAL to process PROCESS.
1968 SIGNAL may be an integer, or a symbol naming a signal, like `SIGSEGV'.
1969 PROCESS may be a process, a buffer, the name of a process or buffer, or
1970 nil, indicating the current buffer's process.
1971 Third arg CURRENT-GROUP non-nil means send signal to the current
1972 foreground process group of the process's controlling terminal rather
1973 than to the process's own process group.
1974 If the process is a shell that supports job control, this means
1975 send the signal to the current subjob rather than the shell.
1977 (signal_, process, current_group))
1979 /* This function can GC */
1980 process_send_signal(process, decode_signal(signal_),
1981 !NILP(current_group), 0);
1985 DEFUN("interrupt-process", Finterrupt_process, 0, 2, 0, /*
1986 Interrupt process PROCESS.
1987 See function `process-send-signal' for more details on usage.
1989 (process, current_group))
1991 /* This function can GC */
1992 process_send_signal(process, SIGINT, !NILP(current_group), 0);
1996 DEFUN("kill-process", Fkill_process, 0, 2, 0, /*
1997 Kill process PROCESS.
1998 See function `process-send-signal' for more details on usage.
2000 (process, current_group))
2002 /* This function can GC */
2004 process_send_signal(process, SIGKILL, !NILP(current_group), 0);
2006 error("kill-process: Not supported on this system");
2011 DEFUN("quit-process", Fquit_process, 0, 2, 0, /*
2012 Send QUIT signal to process PROCESS.
2013 See function `process-send-signal' for more details on usage.
2015 (process, current_group))
2017 /* This function can GC */
2019 process_send_signal(process, SIGQUIT, !NILP(current_group), 0);
2021 error("quit-process: Not supported on this system");
2026 DEFUN("stop-process", Fstop_process, 0, 2, 0, /*
2027 Stop process PROCESS.
2028 See function `process-send-signal' for more details on usage.
2030 (process, current_group))
2032 /* This function can GC */
2034 process_send_signal(process, SIGTSTP, !NILP(current_group), 0);
2036 error("stop-process: Not supported on this system");
2041 DEFUN("continue-process", Fcontinue_process, 0, 2, 0, /*
2042 Continue process PROCESS.
2043 See function `process-send-signal' for more details on usage.
2045 (process, current_group))
2047 /* This function can GC */
2049 process_send_signal(process, SIGCONT, !NILP(current_group), 0);
2051 error("continue-process: Not supported on this system");
2056 DEFUN("signal-process", Fsignal_process, 2, 2, "nProcess number: \nnSignal code: ", /*
2057 Send the process with process id PID the signal with code SIGNAL.
2058 PID must be an integer. The process need not be a child of this Emacs.
2059 SIGNAL may be an integer, or a symbol naming a signal, like `SIGSEGV'.
2065 return make_int(PROCMETH_OR_GIVEN(kill_process_by_pid,
2066 (XINT(pid), decode_signal(signal_)),
2070 DEFUN("process-send-eof", Fprocess_send_eof, 0, 1, 0, /*
2071 Make PROCESS see end-of-file in its input.
2072 PROCESS may be a process, a buffer, the name of a process or buffer, or
2073 nil, indicating the current buffer's process.
2074 If PROCESS is a network connection, or is a process communicating
2075 through a pipe (as opposed to a pty), then you cannot send any more
2076 text to PROCESS after you call this function.
2080 /* This function can GC */
2081 process = get_process(process);
2083 /* Make sure the process is really alive. */
2084 if (!EQ(XPROCESS(process)->status_symbol, Qrun))
2085 error("Process %s not running",
2086 XSTRING_DATA(XPROCESS(process)->name));
2088 if (!MAYBE_INT_PROCMETH(process_send_eof, (process))) {
2089 if (!NILP(DATA_OUTSTREAM(XPROCESS(process)))) {
2090 Lstream_close(XLSTREAM
2091 (DATA_OUTSTREAM(XPROCESS(process))));
2092 event_stream_delete_stream_pair(Qnil,
2095 XPROCESS(process)->pipe_outstream = Qnil;
2097 XPROCESS(process)->coding_outstream = Qnil;
2105 /************************************************************************/
2106 /* deleting a process */
2107 /************************************************************************/
2109 void deactivate_process(Lisp_Object process)
2111 Lisp_Process *p = XPROCESS(process);
2114 /* It's possible that we got as far in the process-creation
2115 process as creating the descriptors but didn't get so
2116 far as selecting the process for input. In this
2117 case, p->pid is nil: p->pid is set at the same time that
2118 the process is selected for input. */
2119 /* #### The comment does not look correct. event_stream_unselect_process
2120 is guarded by process->selected, so this is not a problem. - kkm */
2121 /* Must call this before setting the streams to nil */
2122 event_stream_unselect_process(p);
2124 if (!NILP(DATA_OUTSTREAM(p)))
2125 Lstream_close(XLSTREAM(DATA_OUTSTREAM(p)));
2126 if (!NILP(DATA_INSTREAM(p)))
2127 Lstream_close(XLSTREAM(DATA_INSTREAM(p)));
2129 /* Provide minimal implementation for deactivate_process
2130 if there's no process-specific one */
2131 if (HAS_PROCMETH_P(deactivate_process))
2132 usid = PROCMETH(deactivate_process, (p));
2134 usid = event_stream_delete_stream_pair(p->pipe_instream,
2137 if (usid != USID_DONTHASH)
2138 remhash((const void *)usid, usid_to_process);
2140 p->pipe_instream = Qnil;
2141 p->pipe_outstream = Qnil;
2143 p->coding_instream = Qnil;
2144 p->coding_outstream = Qnil;
2148 static void remove_process(Lisp_Object process)
2150 Vprocess_list = delq_no_quit(process, Vprocess_list);
2151 Fset_marker(XPROCESS(process)->mark, Qnil, Qnil);
2153 deactivate_process(process);
2156 DEFUN("delete-process", Fdelete_process, 1, 1, 0, /*
2157 Delete PROCESS: kill it and forget about it immediately.
2158 PROCESS may be a process or the name of one, or a buffer name.
2162 /* This function can GC */
2164 process = get_process(process);
2165 p = XPROCESS(process);
2166 if (network_connection_p(process)) {
2167 p->status_symbol = Qexit;
2172 } else if (PROCESS_LIVE_P(p)) {
2173 Fkill_process(process, Qnil);
2174 /* Do this now, since remove_process will make sigchld_handler do nothing. */
2175 p->status_symbol = Qsignal;
2176 p->exit_code = SIGKILL;
2182 remove_process(process);
2186 /* Kill all processes associated with `buffer'.
2187 If `buffer' is nil, kill all processes */
2189 void kill_buffer_processes(Lisp_Object buffer)
2191 LIST_LOOP_2(process, Vprocess_list)
2192 if ((NILP(buffer) || EQ(XPROCESS(process)->buffer, buffer))) {
2193 if (network_connection_p(process))
2194 Fdelete_process(process);
2195 else if (PROCESS_LIVE_P(XPROCESS(process)))
2196 process_send_signal(process, SIGHUP, 0, 1);
2200 DEFUN("process-kill-without-query", Fprocess_kill_without_query, 1, 2, 0, /*
2201 Say no query needed if PROCESS is running when Emacs is exited.
2202 Optional second argument if non-nil says to require a query.
2203 Value is t if a query was formerly required.
2205 (process, require_query_p))
2209 CHECK_PROCESS(process);
2210 tem = XPROCESS(process)->kill_without_query;
2211 XPROCESS(process)->kill_without_query = NILP(require_query_p);
2213 return tem ? Qnil : Qt;
2216 DEFUN("process-kill-without-query-p", Fprocess_kill_without_query_p, 1, 1, 0, /*
2217 Return t if PROCESS will be killed without query when emacs is exited.
2221 CHECK_PROCESS(process);
2222 return XPROCESS(process)->kill_without_query ? Qt : Qnil;
2226 mark_usid_to_process(Lisp_Object obj)
2228 struct hash_table *ht = get_dynacat(obj);
2233 mark_object((Lisp_Object)ht->zero_entry);
2236 for (e = ht->harray, limit = e + ht->size; e < limit; e++) {
2238 mark_object((Lisp_Object)e->contents);
2242 /* This is not named init_process in order to avoid a conflict with NS 3.3 */
2243 void init_sxemacs_process(void)
2245 MAYBE_PROCMETH(init_process, ());
2247 Vprocess_list = Qnil;
2249 if (usid_to_process) {
2250 clrhash(usid_to_process);
2253 usid_to_process = make_hash_table(32);
2254 Vusid_to_process = make_dynacat(usid_to_process);
2255 set_dynacat_marker(Vusid_to_process, mark_usid_to_process);
2259 void syms_of_process(void)
2261 INIT_LRECORD_IMPLEMENTATION(process);
2263 defsymbol(&Qprocessp, "processp");
2264 defsymbol(&Qprocess_live_p, "process-live-p");
2266 /* see comment at Fprocess_readable_p */
2267 defsymbol(&Qprocess_readable_p, "process-readable-p");
2269 defsymbol(&Qrun, "run");
2270 defsymbol(&Qstop, "stop");
2271 defsymbol(&Qopen, "open");
2272 defsymbol(&Qclosed, "closed");
2274 defsymbol(&Qtcp, "tcp");
2275 defsymbol(&Qudp, "udp");
2277 #ifdef HAVE_MULTICAST
2278 defsymbol(&Qmulticast, "multicast"); /* Used for occasional warnings */
2282 DEFSUBR(Fprocess_live_p);
2284 /* see comment at Fprocess_readable_p */
2285 DEFSUBR(Fprocess_readable_p);
2287 DEFSUBR(Fget_process);
2288 DEFSUBR(Fget_buffer_process);
2289 DEFSUBR(Fdelete_process);
2290 DEFSUBR(Fprocess_status);
2291 DEFSUBR(Fprocess_exit_status);
2292 DEFSUBR(Fprocess_id);
2293 DEFSUBR(Fprocess_name);
2294 DEFSUBR(Fprocess_tty_name);
2295 DEFSUBR(Fprocess_command);
2296 DEFSUBR(Fset_process_buffer);
2297 DEFSUBR(Fprocess_buffer);
2298 DEFSUBR(Fprocess_mark);
2299 DEFSUBR(Fset_process_filter);
2300 DEFSUBR(Fprocess_filter);
2301 DEFSUBR(Fprocess_type_data);
2302 DEFSUBR(Fset_process_window_size);
2303 DEFSUBR(Fset_process_sentinel);
2304 DEFSUBR(Fprocess_sentinel);
2305 DEFSUBR(Fprocess_kill_without_query);
2306 DEFSUBR(Fprocess_kill_without_query_p);
2307 DEFSUBR(Fprocess_list);
2308 DEFSUBR(Fstart_process_internal);
2310 defsymbol(&Qip_any, "ip_any");
2311 defsymbol(&Qlocalhost, "localhost");
2312 DEFSUBR(Fopen_network_stream_internal);
2313 DEFSUBR(Fopen_network_server_stream_internal);
2314 DEFSUBR(Fnetwork_process_listener);
2315 #ifdef HAVE_MULTICAST
2316 DEFSUBR(Fopen_multicast_group_internal);
2317 #endif /* HAVE_MULTICAST */
2318 #endif /* HAVE_SOCKETS */
2319 DEFSUBR(Fconnect_file_descriptor);
2320 DEFSUBR(Fprocess_send_region);
2321 DEFSUBR(Fprocess_send_string);
2322 DEFSUBR(Fprocess_send_signal);
2323 DEFSUBR(Finterrupt_process);
2324 DEFSUBR(Fkill_process);
2325 DEFSUBR(Fquit_process);
2326 DEFSUBR(Fstop_process);
2327 DEFSUBR(Fcontinue_process);
2328 DEFSUBR(Fprocess_send_eof);
2329 DEFSUBR(Fsignal_process);
2330 /* DEFSUBR (Fprocess_connection); */
2332 DEFSUBR(Fprocess_input_coding_system);
2333 DEFSUBR(Fprocess_output_coding_system);
2334 DEFSUBR(Fset_process_input_coding_system);
2335 DEFSUBR(Fset_process_output_coding_system);
2336 DEFSUBR(Fprocess_coding_system);
2337 DEFSUBR(Fset_process_coding_system);
2338 #endif /* FILE_CODING */
2341 void vars_of_process(void)
2343 Fprovide(intern("subprocesses"));
2345 Fprovide(intern("network-streams"));
2346 #ifdef HAVE_MULTICAST
2347 Fprovide(intern("multicast"));
2348 #endif /* HAVE_MULTICAST */
2349 #endif /* HAVE_SOCKETS */
2350 staticpro(&Vprocess_list);
2351 staticpro(&Vusid_to_process);
2353 DEFVAR_BOOL("delete-exited-processes", &delete_exited_processes /*
2354 *Non-nil means delete processes immediately when they exit.
2355 nil means don't delete them until `list-processes' is run.
2358 delete_exited_processes = 1;
2360 DEFVAR_CONST_LISP("null-device", &Vnull_device /*
2361 Name of the null device, which differs from system to system.
2362 The null device is a filename that acts as a sink for arbitrary amounts of
2363 data, which is discarded, or as a source for a zero-length file.
2364 It is available on all the systems that we currently support, but with
2365 different names (typically either `/dev/null' or `nul').
2367 Note that there is also a /dev/zero on most modern Unix versions,
2368 which acts like /dev/null when used as a sink, but as a source it
2369 sends a non-ending stream of zero bytes. It's used most often along
2370 with memory-mapping. We don't provide a Lisp variable for this
2371 because the operations needing this are lower level than what ELisp
2372 programs typically do.
2374 Vnull_device = build_string(NULL_DEVICE);
2376 DEFVAR_LISP("process-connection-type", &Vprocess_connection_type /*
2377 Control type of device used to communicate with subprocesses.
2378 Values are nil to use a pipe, or t or `pty' to use a pty.
2379 The value has no effect if the system has no ptys or if all ptys are busy:
2380 then a pipe is used in any case.
2381 The value takes effect when `start-process' is called.
2383 Vprocess_connection_type = Qt;
2385 DEFVAR_BOOL("windowed-process-io", &windowed_process_io /*
2386 Enables input/output on standard handles of a windowed process.
2387 When this variable is nil (the default), SXEmacs does not attempt to read
2388 standard output handle of a windowed process. Instead, the process is
2389 immediately marked as exited immediately upon successful launching. This is
2390 done because normal windowed processes do not use standard I/O, as they are
2391 not connected to any console.
2393 When launching a specially crafted windowed process, which expects to be
2394 launched by SXEmacs, or by other program which pipes its standard input and
2395 output, this variable must be set to non-nil, in which case SXEmacs will
2396 treat this process just like a console process.
2398 NOTE: You should never set this variable, only bind it.
2400 Only Windows processes can be "windowed" or "console". This variable has no
2401 effect on UNIX processes, because all UNIX processes are "console".
2403 windowed_process_io = 0;
2405 #ifdef PROCESS_IO_BLOCKING
2406 DEFVAR_LISP("network-stream-blocking-port-list", &network_stream_blocking_port_list /*
2407 List of port numbers or port names to set a blocking I/O mode with connection.
2408 Nil value means to set a default(non-blocking) I/O mode.
2409 The value takes effect when `open-network-stream-internal' is called.
2411 network_stream_blocking_port_list = Qnil;
2412 #endif /* PROCESS_IO_BLOCKING */
2415 #endif /* not NO_SUBPROCESSES */