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. */
476 Lisp_Object tem = Fget_process(name1);
479 sprintf(suffix, "<%d>", i);
480 name1 = concat2(name, build_string(suffix));
489 p->mark = Fmake_marker();
491 p->status_symbol = Qrun;
494 p->filter_does_read = 0;
495 p->kill_without_query = 0;
499 p->pipe_instream = Qnil;
500 p->pipe_outstream = Qnil;
502 p->coding_instream = Qnil;
503 p->coding_outstream = Qnil;
505 p->process_type = PROCESS_TYPE_PROC;
506 p->process_type_data = Qnil;
509 MAYBE_PROCMETH(alloc_process_data, (p));
513 Vprocess_list = Fcons(val, Vprocess_list);
517 void init_process_io_handles(Lisp_Process * p, void *in, void *out, int flags)
519 USID usid = event_stream_create_stream_pair(in, out,
524 if (usid == USID_ERROR)
525 report_file_error("Setting up communication with subprocess",
528 if (usid != USID_DONTHASH) {
529 Lisp_Object process = Qnil;
530 XSETPROCESS(process, p);
531 puthash((const void *)usid, LISP_TO_VOID(process),
535 MAYBE_PROCMETH(init_process_io_handles, (p, in, out, flags));
538 p->coding_instream = make_decoding_input_stream
539 (XLSTREAM(p->pipe_instream),
540 Fget_coding_system(Vcoding_system_for_read));
541 Lstream_set_character_mode(XLSTREAM(p->coding_instream));
542 p->coding_outstream = make_encoding_output_stream
543 (XLSTREAM(p->pipe_outstream),
544 Fget_coding_system(Vcoding_system_for_write));
545 /* CODE_CNTL (&out_state[outchannel]) |= CC_END; !!####
546 What's going on here? */
547 #endif /* FILE_CODING */
551 create_process(Lisp_Object process, Lisp_Object * argv, int nargv,
552 Lisp_Object program, Lisp_Object cur_dir)
554 Lisp_Process *p = XPROCESS(process);
557 /* *_create_process may change status_symbol, if the process
558 is a kind of "fire-and-forget" (no I/O, unwaitable) */
559 p->status_symbol = Qrun;
562 pid = PROCMETH(create_process, (p, argv, nargv, program, cur_dir));
564 p->pid = make_int(pid);
565 if (PROCESS_READABLE_P(p))
566 event_stream_select_process(p);
569 /* This function is the unwind_protect form for Fstart_process_internal. If
570 PROCESS doesn't have its pid set, then we know someone has signalled
571 an error and the process wasn't started successfully, so we should
572 remove it from the process list. */
573 static void remove_process(Lisp_Object process);
574 static Lisp_Object start_process_unwind(Lisp_Object process)
576 /* Was PROCESS started successfully? */
577 if (EQ(XPROCESS(process)->pid, Qnil))
578 remove_process(process);
582 DEFUN("start-process-internal", Fstart_process_internal, 3, MANY, 0, /*
583 Start a program in a subprocess. Return the process object for it.
584 Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS
585 NAME is name for process. It is modified if necessary to make it unique.
586 BUFFER is the buffer or (buffer-name) to associate with the process.
587 Process output goes at end of that buffer, unless you specify
588 an output stream or filter function to handle the output.
589 BUFFER may be also nil, meaning that this process is not associated
591 Third arg is program file name. It is searched for as in the shell.
592 Remaining arguments are strings to give program as arguments.
593 If bound, `coding-system-for-read' and `coding-system-for-write' specify
594 the coding-system objects used in input from and output to the process.
596 (int nargs, Lisp_Object * args))
598 /* This function can call lisp */
599 /* !!#### This function has not been Mule-ized */
600 Lisp_Object buffer, name, program, process, current_dir;
603 int speccount = specpdl_depth();
604 struct gcpro gcpro1, gcpro2, gcpro3;
611 /* Protect against various file handlers doing GCs below. */
612 GCPRO3(buffer, program, current_dir);
615 buffer = Fget_buffer_create(buffer);
618 CHECK_STRING(program);
619 for (i = 3; i < nargs; ++i)
620 CHECK_STRING(args[i]);
622 /* Make sure that the child will be able to chdir to the current
623 buffer's current directory, or its unhandled equivalent. We
624 can't just have the child check for an error when it does the
625 chdir, since it's in a vfork.
627 Note: these assignments and calls are like this in order to insure
628 "caller protects args" GC semantics. */
629 current_dir = current_buffer->directory;
630 current_dir = Funhandled_file_name_directory(current_dir);
631 current_dir = expand_and_dir_to_file(current_dir, Qnil);
633 #if 0 /* This loser breaks ange-ftp */
634 /* dmoore - if you re-enable this code, you have to gcprotect
635 current_buffer through the above calls. */
636 if (NILP(Ffile_accessible_directory_p(current_dir)))
637 report_file_error("Setting current directory",
638 list1(current_buffer->directory));
641 /* If program file name is not absolute, search our path for it */
642 if (!IS_DIRECTORY_SEP(XSTRING_BYTE(program, 0))
643 && !(XSTRING_LENGTH(program) > 1
644 && IS_DEVICE_SEP(XSTRING_BYTE(program, 1)))) {
645 struct gcpro ngcpro1;
649 locate_file(Vexec_path, program, Vlisp_EXEC_SUFFIXES, &tem,
652 report_file_error("Searching for program",
654 program = Fexpand_file_name(tem, Qnil);
657 /* we still need to canonicalize it and ensure it has the proper
659 struct gcpro ngcpro1;
663 locate_file(list1(build_string("")), program,
664 Vlisp_EXEC_SUFFIXES, &tem, X_OK);
666 report_file_error("Searching for program",
672 if (!NILP(Ffile_directory_p(program)))
674 ("Specified program for new process is a directory",
677 process = make_process_internal(name);
679 XPROCESS(process)->buffer = buffer;
680 XPROCESS(process)->command = Flist(nargs - 2, args + 2);
682 /* Make the process marker point into the process buffer (if any). */
684 Fset_marker(XPROCESS(process)->mark,
685 make_int(BUF_ZV(XBUFFER(buffer))), buffer);
687 /* If an error occurs and we can't start the process, we want to
688 remove it from the process list. This means that each error
689 check in create_process doesn't need to call remove_process
690 itself; it's all taken care of here. */
691 record_unwind_protect(start_process_unwind, process);
693 create_process(process, args + 3, nargs - 3, program, current_dir);
696 return unbind_to(speccount, process);
701 /* #### The network support is fairly synthetical. What we actually
702 need is a single function, which supports all datagram, stream and
703 packet stream connections, arbitrary protocol families should they
704 be supported by the target system, multicast groups, in both data
705 and control rooted/nonrooted flavors, service quality etc whatever
706 is supported by the underlying network.
708 It must accept a property list describing the connection. The current
709 functions must then go to lisp and provide a suitable list for the
710 generalized connection function.
712 All modern UNIX other OSs support BSD sockets, and there are many
713 extensions available (Sockets 2 spec).
715 A todo is define a consistent set of properties abstracting a
716 network connection. -kkm
721 DEFUN("network-process-listener", Fnetwork_process_listener, 1, 1, 0, /*
722 Returns the process that listened and accepted the given
723 network-process. Returns nil if process is closed or was not accepted
724 through a network server stream.
728 PROCESS should be a network-stream process accepted through a network
733 CHECK_PROCESS(process);
734 return MAYBE_LISP_PROCMETH(network_process_listener, (process));
738 /* Listen for a TCP network connection to a given SERVICE. Treated
739 exactly like a normal process when reading and writing. Only
740 differences are in status display and process deletion. A network
741 connection has no PID; you cannot signal it. All you can do is
742 deactivate and close it via delete-process. You must provide a
744 DEFUN("open-network-server-stream-internal", Fopen_network_server_stream_internal, 4, 8, 0, /*
745 Returns a process object to represent the listening connection. When a
746 new connection request arrives, it is automatically accepted. A
747 network-stream process is automatically created for that
748 connection. If needed a new buffer is also created. If given the
749 acceptor function is called. If defined filter and sentinel are set
750 for the new connection process .
752 Input and output work as for subprocesses; `delete-process' closes it.
754 Args are NAME BUFFER HOST SERVICE &optional PROTOCOL ACCEPTOR .
756 NAME is name for process. It is modified if necessary to make it
759 BUFFER is the buffer (or buffer-name) to associate with the process.
760 Listening Process output goes at end of that buffer, unless you
761 specify an output stream or filter function to handle the output. No
762 real process output of listening process is expected. However the
763 name of this buffer will be used as a base for generating a new
764 buffer name for the accepted connections.
765 The BUFFER may be also nil, meaning that this process is not
766 associated with any buffer. In this case a filter should be specified
767 otherwise there will be no way to retrieve the process output.
768 BUFFER may also be 'auto in which case a buffer is automatically
769 created for the accepted connection.
771 Third arg HOST (a string) is the name of the IP to bind to, or its
772 IP address, If nil or ip_any will bind to all addresses on the
773 machine. When HOST is 'localhost listening connection will listen
774 to connections from the local machine only.
775 Fourth arg SERVICE is name of the service desired, or an integer
776 specifying a port number to connect to.
777 Fifth argument PROTOCOL is a network protocol. Currently 'tcp
778 (Transmission Control Protocol) and 'udp (User Datagram Protocol) are
779 supported. When omitted, 'tcp is assumed.
780 Sixt argument ACCEPTOR is a function which will be called upon connection
781 acceptance with the accepted connection process as the single argument.
782 Seventh argument FILTER is a function which will be set as filter for
783 the accepted connections automatically. See `set-process-filter' for
785 Eight argument SENTINEL is a function which will be set as sentinel
786 the accepted connections automatically. see `set-process-sentinel'
789 Output via `process-send-string' and input via buffer or filter (see
790 `set-process-filter') are stream-oriented. That means UDP datagrams are
791 not guaranteed to be sent and received in discrete packets. (But small
792 datagrams around 500 bytes that are not truncated by `process-send-string'
793 are usually fine.) Note further that UDP protocol does not guard against
796 In the ACCEPTOR you can use `network-process-listener' to get the original
797 listen process, and `process-buffer' to retrieve the associated
798 buffers. If sentinels and/or filters are set in the ACCEPTOR they
799 will override the FILTER and SENTINEL args to this function.
801 (name, buffer, host, service, protocol, acceptor, filter, sentinel))
804 /* !!#### This function has not been Mule-ized */
805 /* This function can GC */
806 Lisp_Object process = Qnil;
807 Lisp_Object bufname = Qnil;
808 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6, gcpro7, gcpro8, ngcpro1, ngcpro2;
811 GCPRO8(name, buffer, host, service, protocol, acceptor, filter, sentinel);
817 CHECK_SYMBOL(protocol);
822 /* Since this code is inside HAVE_SOCKETS, existence of
823 open_network_stream is mandatory */
824 PROCMETH(open_network_server_stream, (name, host, service, protocol,
827 NGCPRO2(process,bufname);
828 if (!NILP(buffer) && !SYMBOLP(buffer)) {
829 buffer = Fget_buffer_create(buffer);
830 bufname = Fbuffer_name(buffer);
831 } else if (SYMBOLP(buffer) && !NILP(buffer) && ! EQ(Qauto,buffer) ) {
832 error("unknown buffer symbol %s",
833 string_data(symbol_name(XSYMBOL(buffer))));
837 Lisp_Object args[] = {
838 build_string("<listen proc:%S host:%S service:%S protocol:%S>"),
839 name, host, service, protocol
841 bufname = Fformat( 5, args );
844 process = make_process_internal(name);
846 XPROCESS(process)->pid = Fcons(service, host);
847 XPROCESS(process)->process_type = PROCESS_TYPE_NETWORK_SERVER_LISTEN;
848 XPROCESS(process)->buffer = buffer;
850 /* Just opened a scope because I like to keep definitions close to
851 usage specially temporary ones... */
852 Lisp_Object args[] = { acceptor, filter, sentinel, bufname };
853 XPROCESS(process)->process_type_data = Flist(4,args);
855 init_process_io_handles(XPROCESS(process), (void *)inch, (void *)outch,
856 STREAM_NETWORK_SERVER_CONNECTION);
858 event_stream_select_process(XPROCESS(process));
866 /* open a TCP network connection to a given HOST/SERVICE. Treated
867 exactly like a normal process when reading and writing. Only
868 differences are in status display and process deletion. A network
869 connection has no PID; you cannot signal it. All you can do is
870 deactivate and close it via delete-process */
872 DEFUN("open-network-stream-internal", Fopen_network_stream_internal, 4, 5, 0, /*
873 Open a TCP connection for a service to a host.
874 Return a process object to represent the connection.
875 Input and output work as for subprocesses; `delete-process' closes it.
877 NAME is name for process. It is modified if necessary to make it unique.
878 BUFFER is the buffer (or buffer-name) to associate with the process.
879 Process output goes at end of that buffer, unless you specify
880 an output stream or filter function to handle the output.
881 BUFFER may also be nil, meaning that this process is not associated
883 Third arg HOST (a string) is the name of the host to connect to,
885 Fourth arg SERVICE is the name of the service desired (a string),
886 or an integer specifying a port number to connect to.
887 Optional fifth arg PROTOCOL is a network protocol. Currently only 'tcp
888 (Transmission Control Protocol) and 'udp (User Datagram Protocol) are
889 supported. When omitted, 'tcp is assumed.
891 Output via `process-send-string' and input via buffer or filter (see
892 `set-process-filter') are stream-oriented. That means UDP datagrams are
893 not guaranteed to be sent and received in discrete packets. (But small
894 datagrams around 500 bytes that are not truncated by `process-send-string'
895 are usually fine.) Note further that the UDP protocol does not guard
896 against lost packets.
898 (name, buffer, host, service, protocol))
900 /* !!#### This function has not been Mule-ized */
901 /* This function can GC */
902 Lisp_Object process = Qnil;
903 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, ngcpro1;
906 GCPRO5(name, buffer, host, service, protocol);
912 CHECK_SYMBOL(protocol);
914 /* Since this code is inside HAVE_SOCKETS, existence of
915 open_network_stream is mandatory */
916 PROCMETH(open_network_stream, (name, host, service, protocol,
920 buffer = Fget_buffer_create(buffer);
921 process = make_process_internal(name);
924 XPROCESS(process)->pid = Fcons(service, host);
925 XPROCESS(process)->process_type = PROCESS_TYPE_NETWORK;
926 XPROCESS(process)->buffer = buffer;
927 init_process_io_handles(XPROCESS(process), (void *)inch, (void *)outch,
928 STREAM_NETWORK_CONNECTION);
930 event_stream_select_process(XPROCESS(process));
937 DEFUN("connect-file-descriptor", Fconnect_file_descriptor, 4, 4, 0, /*
938 Connect to an existing file descriptor.
939 Return a subprocess-object to represent the connection.
940 Input and output work as for subprocesses; `delete-process' closes it.
941 Args are NAME BUFFER INFD OUTFD.
942 NAME is name for process. It is modified if necessary to make it unique.
943 BUFFER is the buffer (or buffer-name) to associate with the process.
944 Process output goes at end of that buffer, unless you specify
945 an output stream or filter function to handle the output.
946 BUFFER may also be nil, meaning that this process is not associated
948 INFD and OUTFD specify the file descriptors to use for input and
949 output, respectively.
951 (name, buffer, infd, outfd))
953 return connect_to_file_descriptor(name, buffer, infd, outfd);
956 #ifdef HAVE_MULTICAST
958 DEFUN("open-multicast-group-internal", Fopen_multicast_group_internal, 5, 5, 0, /*
959 Open a multicast connection on the specified dest/port/ttl.
960 Return a process object to represent the connection.
961 Input and output work as for subprocesses; `delete-process' closes it.
963 NAME is name for process. It is modified if necessary to make it unique.
964 BUFFER is the buffer (or buffer-name) to associate with the process.
965 Process output goes at end of that buffer, unless you specify
966 an output stream or filter function to handle the output.
967 BUFFER may also be nil, meaning that this process is not associated
969 Third, fourth and fifth args are the multicast destination group, port and ttl.
970 dest must be an internet address between 224.0.0.0 and 239.255.255.255
971 port is a communication port like in traditional unicast
972 ttl is the time-to-live (15 for site, 63 for region and 127 for world)
974 (name, buffer, dest, port, ttl))
976 /* !!#### This function has not been Mule-ized */
977 /* This function can GC */
978 Lisp_Object process = Qnil;
984 /* Since this code is inside HAVE_MULTICAST, existence of
985 open_network_stream is mandatory */
986 PROCMETH(open_multicast_group, (name, dest, port, ttl, &inch, &outch));
989 buffer = Fget_buffer_create(buffer);
991 process = make_process_internal(name);
994 XPROCESS(process)->pid = Fcons(port, dest);
995 XPROCESS(process)->process_type = PROCESS_TYPE_MULTICAST;
996 XPROCESS(process)->buffer = buffer;
997 init_process_io_handles(XPROCESS(process), (void *)inch, (void *)outch,
998 STREAM_NETWORK_CONNECTION);
1000 event_stream_select_process(XPROCESS(process));
1005 #endif /* HAVE_MULTICAST */
1007 #endif /* HAVE_SOCKETS */
1009 Lisp_Object canonicalize_host_name(Lisp_Object host)
1011 return PROCMETH_OR_GIVEN(canonicalize_host_name, (host), host);
1014 DEFUN("set-process-window-size", Fset_process_window_size, 3, 3, 0, /*
1015 Tell PROCESS that it has logical window size HEIGHT and WIDTH.
1017 (process, height, width))
1019 CHECK_PROCESS(process);
1020 CHECK_NATNUM(height);
1021 CHECK_NATNUM(width);
1023 MAYBE_INT_PROCMETH(set_window_size,
1024 (XPROCESS(process), XINT(height),
1025 XINT(width))) <= 0 ? Qnil : Qt;
1028 /************************************************************************/
1030 /************************************************************************/
1032 /* Read pending output from the process channel,
1033 starting with our buffered-ahead character if we have one.
1034 Yield number of characters read.
1036 This function reads at most 1024 bytes.
1037 If you want to read all available subprocess output,
1038 you must call it repeatedly until it returns zero. */
1040 Charcount read_process_output(Lisp_Object process)
1042 /* This function can GC */
1043 Bytecount nbytes, nchars;
1044 Bufbyte chars[1024];
1045 Lisp_Object outstream;
1046 Lisp_Process *p = XPROCESS(process);
1048 /* If there is a lot of output from the subprocess, the loop in
1049 execute_internal_event() might call read_process_output() more
1050 than once. If the filter that was executed from one of these
1051 calls set the filter to t, we have to stop now. Return -1 rather
1052 than 0 so execute_internal_event() doesn't close the process.
1053 Really, the loop in execute_internal_event() should check itself
1054 for a process-filter change, like in status_notify(); but the
1055 struct Lisp_Process is not exported outside of this file. */
1056 if (!PROCESS_READABLE_P(p))
1057 return -1; /* already closed */
1059 if (!NILP(p->filter) && (p->filter_does_read)) {
1060 Lisp_Object filter_result;
1062 /* Some weird FSFmacs crap here with
1063 Vdeactivate_mark and current_buffer->keymap */
1064 running_asynch_code = 1;
1065 filter_result = call2_trapping_errors("Error in process filter",
1066 p->filter, process, Qnil);
1067 running_asynch_code = 0;
1068 restore_match_data();
1069 CHECK_INT(filter_result);
1070 return XINT(filter_result);
1073 switch (p->process_type) {
1074 case PROCESS_TYPE_NETWORK_SERVER_LISTEN:
1075 /* We must have add a connect... We should accept and call
1077 PROCMETH(network_server_accept, (wrap_object(p)));
1080 case PROCESS_TYPE_PROC:
1081 case PROCESS_TYPE_NETWORK:
1082 case PROCESS_TYPE_MULTICAST:
1083 case PROCESS_TYPE_SSL:
1085 nbytes = Lstream_read(XLSTREAM(DATA_INSTREAM(p)),
1086 chars, sizeof(chars));
1093 nchars = bytecount_to_charcount(chars, nbytes);
1094 outstream = p->filter;
1095 if (!NILP(outstream)) {
1096 /* We used to bind inhibit-quit to t here, but
1097 call2_trapping_errors() does that for us. */
1098 running_asynch_code = 1;
1099 call2_trapping_errors("Error in process filter",
1100 outstream, process, make_string(chars,
1102 running_asynch_code = 0;
1103 restore_match_data();
1107 /* If no filter, write into buffer if it isn't dead. */
1108 if (!NILP(p->buffer) && BUFFER_LIVE_P(XBUFFER(p->buffer))) {
1109 Lisp_Object old_read_only = Qnil;
1113 int old_zmacs_region_stays = zmacs_region_stays;
1114 struct gcpro gcpro1, gcpro2;
1115 struct buffer *buf = XBUFFER(p->buffer);
1117 GCPRO2(process, old_read_only);
1119 old_point = BUF_PT(buf);
1120 old_begv = BUF_BEGV(buf);
1121 old_zv = BUF_ZV(buf);
1122 old_read_only = buf->read_only;
1123 buf->read_only = Qnil;
1125 /* Insert new output into buffer
1126 at the current end-of-output marker,
1127 thus preserving logical ordering of input and output. */
1128 if (XMARKER(p->mark)->buffer)
1130 bufpos_clip_to_bounds(old_begv,
1135 BUF_SET_PT(buf, old_zv);
1137 /* If the output marker is outside of the visible region, save
1138 the restriction and widen. */
1139 if (!(BUF_BEGV(buf) <= BUF_PT(buf) &&
1140 BUF_PT(buf) <= BUF_ZV(buf)))
1143 /* Make sure opoint floats ahead of any new text, just as point
1145 if (BUF_PT(buf) <= old_point)
1146 old_point += nchars;
1148 /* Insert after old_begv, but before old_zv. */
1149 if (BUF_PT(buf) < old_begv)
1151 if (BUF_PT(buf) <= old_zv)
1155 /* This screws up initial display of the window. jla */
1157 /* Insert before markers in case we are inserting where
1158 the buffer's mark is, and the user's next command is Meta-y. */
1159 buffer_insert_raw_string_1(buf, -1, chars,
1160 nbytes, INSDEL_BEFORE_MARKERS);
1162 buffer_insert_raw_string(buf, chars, nbytes);
1165 Fset_marker(p->mark, make_int(BUF_PT(buf)), p->buffer);
1167 MARK_MODELINE_CHANGED;
1169 /* If the restriction isn't what it should be, set it. */
1170 if (old_begv != BUF_BEGV(buf) || old_zv != BUF_ZV(buf)) {
1172 old_begv = bufpos_clip_to_bounds(BUF_BEG(buf),
1173 old_begv, BUF_Z(buf));
1174 old_zv = bufpos_clip_to_bounds(BUF_BEG(buf),
1175 old_zv, BUF_Z(buf));
1176 Fnarrow_to_region(make_int(old_begv), make_int(old_zv),
1180 /* Handling the process output should not deactivate the mark. */
1181 zmacs_region_stays = old_zmacs_region_stays;
1182 buf->read_only = old_read_only;
1183 old_point = bufpos_clip_to_bounds(BUF_BEGV(buf),
1184 old_point, BUF_ZV(buf));
1185 BUF_SET_PT(buf, old_point);
1192 /* Sending data to subprocess */
1194 /* send some data to process PROCESS. If NONRELOCATABLE is non-NULL, it
1195 specifies the address of the data. Otherwise, the data comes from the
1196 object RELOCATABLE (either a string or a buffer). START and LEN
1197 specify the offset and length of the data to send.
1199 Note that START and LEN are in Bufpos's if RELOCATABLE is a buffer,
1200 and in Bytecounts otherwise. */
1203 send_process(Lisp_Object process,
1204 Lisp_Object relocatable, const Bufbyte * nonrelocatable,
1207 /* This function can GC */
1208 struct gcpro gcpro1, gcpro2;
1209 Lisp_Object lstream = Qnil;
1211 GCPRO2(process, lstream);
1213 if (NILP(DATA_OUTSTREAM(XPROCESS(process))))
1214 signal_simple_error("Process not open for writing", process);
1218 make_fixed_buffer_input_stream(nonrelocatable + start, len);
1219 else if (BUFFERP(relocatable))
1220 lstream = make_lisp_buffer_input_stream(XBUFFER(relocatable),
1221 start, start + len, 0);
1224 make_lisp_string_input_stream(relocatable, start, len);
1226 PROCMETH(send_process, (process, XLSTREAM(lstream)));
1229 Lstream_delete(XLSTREAM(lstream));
1232 DEFUN("process-tty-name", Fprocess_tty_name, 1, 1, 0, /*
1233 Return the name of the terminal PROCESS uses, or nil if none.
1234 This is the terminal that the process itself reads and writes on,
1235 not the name of the pty that Emacs uses to talk with that terminal.
1239 CHECK_PROCESS(process);
1240 return MAYBE_LISP_PROCMETH(get_tty_name, (XPROCESS(process)));
1243 DEFUN("set-process-buffer", Fset_process_buffer, 2, 2, 0, /*
1244 Set buffer associated with PROCESS to BUFFER (a buffer, or nil).
1248 CHECK_PROCESS(process);
1250 CHECK_BUFFER(buffer);
1251 XPROCESS(process)->buffer = buffer;
1255 DEFUN("process-buffer", Fprocess_buffer, 1, 1, 0, /*
1256 Return the buffer PROCESS is associated with.
1257 Output from PROCESS is inserted in this buffer
1258 unless PROCESS has a filter.
1262 CHECK_PROCESS(process);
1263 return XPROCESS(process)->buffer;
1266 DEFUN("process-mark", Fprocess_mark, 1, 1, 0, /*
1267 Return the marker for the end of the last output from PROCESS.
1271 CHECK_PROCESS(process);
1272 return XPROCESS(process)->mark;
1276 set_process_filter(Lisp_Object process, Lisp_Object filter,
1277 int filter_does_read)
1279 CHECK_PROCESS(process);
1280 if (PROCESS_READABLE_P(XPROCESS(process))) {
1282 event_stream_unselect_process(XPROCESS(process));
1284 event_stream_select_process(XPROCESS(process));
1287 XPROCESS(process)->filter = filter;
1288 XPROCESS(process)->filter_does_read = filter_does_read;
1291 DEFUN("set-process-filter", Fset_process_filter, 2, 3, 0, /*
1292 Give PROCESS the filter function FILTER; nil means no filter.
1293 t means stop accepting output from the process.
1294 When a process has a filter, each time it does output
1295 the entire string of output is passed to the filter.
1296 The filter gets two arguments: the process and the string of output
1297 unless third FILTER-DOES-READ parameter is non-nil. In that case
1298 output string is nil, and filter must perform reading by itself. It
1299 must return integer value of how much data was read, return 0 if there
1300 is nothing to be read.
1301 If the process has a filter, its buffer is not used for output.
1303 (process, filter, filter_does_read))
1305 set_process_filter(process, filter, !NILP(filter_does_read));
1309 DEFUN("process-filter", Fprocess_filter, 1, 1, 0, /*
1310 Return the filter function of PROCESS; nil if none.
1311 See `set-process-filter' for more info on filter functions.
1315 CHECK_PROCESS(process);
1316 return XPROCESS(process)->filter;
1319 DEFUN("process-type-data", Fprocess_type_data, 1, 1, 0, /*
1320 Return the type data of PROCESS; `nil' if none.
1324 CHECK_PROCESS(process);
1325 return XPROCESS(process)->process_type_data;
1328 DEFUN("process-send-region", Fprocess_send_region, 3, 4, 0, /*
1329 Send current contents of the region between START and END as input to PROCESS.
1330 PROCESS may be a process or the name of a process, or a buffer or the
1331 name of a buffer, in which case the buffer's process is used. If it
1332 is nil, the current buffer's process is used.
1333 BUFFER specifies the buffer to look in; if nil, the current buffer is used.
1334 If STRING is more than 100 or so characters long, it may be sent in
1335 several chunks. This may happen even for shorter strings. Output
1336 from processes can arrive in between chunks.
1338 (process, start, end, buffer))
1340 /* This function can GC */
1341 Bufpos bstart, bend;
1342 struct buffer *buf = decode_buffer(buffer, 0);
1344 XSETBUFFER(buffer, buf);
1345 process = get_process(process);
1346 get_buffer_range_char(buf, start, end, &bstart, &bend, 0);
1348 send_process(process, buffer, 0, bstart, bend - bstart);
1352 DEFUN("process-send-string", Fprocess_send_string, 2, 4, 0, /*
1353 Send PROCESS the contents of STRING as input.
1354 PROCESS may be a process or the name of a process, or a buffer or the
1355 name of a buffer, in which case the buffer's process is used. If it
1356 is nil, the current buffer's process is used.
1357 Optional arguments START and END specify part of STRING; see `substring'.
1358 If STRING is more than 100 or so characters long, it may be sent in
1359 several chunks. This may happen even for shorter strings. Output
1360 from processes can arrive in between chunks.
1362 (process, string, start, end))
1364 /* This function can GC */
1365 Bytecount bstart, bend;
1367 process = get_process(process);
1368 CHECK_STRING(string);
1369 get_string_range_byte(string, start, end, &bstart, &bend,
1370 GB_HISTORICAL_STRING_BEHAVIOR);
1372 send_process(process, string, 0, bstart, bend - bstart);
1378 DEFUN("process-input-coding-system", Fprocess_input_coding_system, 1, 1, 0, /*
1379 Return PROCESS's input coding system.
1383 process = get_process(process);
1384 CHECK_READABLE_PROCESS(process);
1386 decoding_stream_coding_system(XLSTREAM
1387 (XPROCESS(process)->coding_instream));
1390 DEFUN("process-output-coding-system", Fprocess_output_coding_system, 1, 1, 0, /*
1391 Return PROCESS's output coding system.
1395 process = get_process(process);
1396 CHECK_LIVE_PROCESS(process);
1398 encoding_stream_coding_system(XLSTREAM
1399 (XPROCESS(process)->
1403 DEFUN("process-coding-system", Fprocess_coding_system, 1, 1, 0, /*
1404 Return a pair of coding-system for decoding and encoding of PROCESS.
1408 process = get_process(process);
1409 CHECK_READABLE_PROCESS(process);
1410 return Fcons(decoding_stream_coding_system
1411 (XLSTREAM(XPROCESS(process)->coding_instream)),
1412 encoding_stream_coding_system
1413 (XLSTREAM(XPROCESS(process)->coding_outstream)));
1416 DEFUN("set-process-input-coding-system", Fset_process_input_coding_system, 2, 2, 0, /*
1417 Set PROCESS's input coding system to CODESYS.
1421 codesys = Fget_coding_system(codesys);
1422 process = get_process(process);
1423 CHECK_READABLE_PROCESS(process);
1425 set_decoding_stream_coding_system
1426 (XLSTREAM(XPROCESS(process)->coding_instream), codesys);
1430 DEFUN("set-process-output-coding-system",
1431 Fset_process_output_coding_system, 2, 2, 0, /*
1432 Set PROCESS's output coding system to CODESYS.
1436 codesys = Fget_coding_system(codesys);
1437 process = get_process(process);
1438 CHECK_LIVE_PROCESS(process);
1440 set_encoding_stream_coding_system
1441 (XLSTREAM(XPROCESS(process)->coding_outstream), codesys);
1445 DEFUN("set-process-coding-system", Fset_process_coding_system, 1, 3, 0, /*
1446 Set coding-systems of PROCESS to DECODING and ENCODING.
1447 DECODING will be used to decode subprocess output and ENCODING to
1448 encode subprocess input.
1450 (process, decoding, encoding))
1452 if (!NILP(decoding))
1453 Fset_process_input_coding_system(process, decoding);
1455 if (!NILP(encoding))
1456 Fset_process_output_coding_system(process, encoding);
1461 #endif /* FILE_CODING */
1463 /************************************************************************/
1464 /* process status */
1465 /************************************************************************/
1467 static Lisp_Object exec_sentinel_unwind(Lisp_Object datum)
1469 Lisp_Cons *d = XCONS(datum);
1470 XPROCESS(d->car)->sentinel = d->cdr;
1475 static void exec_sentinel(Lisp_Object process, Lisp_Object reason)
1477 /* This function can GC */
1478 int speccount = specpdl_depth();
1479 Lisp_Process *p = XPROCESS(process);
1480 Lisp_Object sentinel = p->sentinel;
1485 /* Some weird FSFmacs crap here with
1486 Vdeactivate_mark and current_buffer->keymap */
1488 /* Zilch the sentinel while it's running, to avoid recursive invocations;
1489 assure that it gets restored no matter how the sentinel exits. */
1491 record_unwind_protect(exec_sentinel_unwind,
1492 noseeum_cons(process, sentinel));
1493 /* We used to bind inhibit-quit to t here, but call2_trapping_errors()
1494 does that for us. */
1495 running_asynch_code = 1;
1496 call2_trapping_errors("Error in process sentinel", sentinel, process,
1498 running_asynch_code = 0;
1499 restore_match_data();
1500 unbind_to(speccount, Qnil);
1503 DEFUN("set-process-sentinel", Fset_process_sentinel, 2, 2, 0, /*
1504 Give PROCESS the sentinel SENTINEL; nil for none.
1505 The sentinel is called as a function when the process changes state.
1506 It gets two arguments: the process, and a string describing the change.
1508 (process, sentinel))
1510 CHECK_PROCESS(process);
1511 XPROCESS(process)->sentinel = sentinel;
1515 DEFUN("process-sentinel", Fprocess_sentinel, 1, 1, 0, /*
1516 Return the sentinel of PROCESS; nil if none.
1517 See `set-process-sentinel' for more info on sentinels.
1521 CHECK_PROCESS(process);
1522 return XPROCESS(process)->sentinel;
1525 const char *signal_name(int signum)
1527 if (signum >= 0 && signum < NSIG)
1529 return (const char *)strsignal(signum);
1530 #elif SXE_SYS_SIGLIST_DECLARED || HAVE_SYS_SIGLIST || SYS_SIGLIST_DECLARED || HAVE_DECL_SYS_SIGLIST
1531 return (const char *)sys_siglist[signum];
1533 return (const char *)GETTEXT("unknown signal - missing signal list");
1536 return (const char *)GETTEXT("unknown signal");
1540 update_process_status(Lisp_Object p,
1541 Lisp_Object status_symbol, int exit_code, int core_dumped)
1543 XPROCESS(p)->tick++;
1545 XPROCESS(p)->status_symbol = status_symbol;
1546 XPROCESS(p)->exit_code = exit_code;
1547 XPROCESS(p)->core_dumped = core_dumped;
1550 /* Return a string describing a process status list. */
1552 static Lisp_Object status_message(Lisp_Process * p)
1554 Lisp_Object symbol = p->status_symbol;
1555 int code = p->exit_code;
1556 int coredump = p->core_dumped;
1557 Lisp_Object string, string2;
1559 if (EQ(symbol, Qsignal) || EQ(symbol, Qstop)) {
1560 string = build_string(signal_name(code));
1562 string2 = build_translated_string(" (core dumped)\n");
1564 string2 = build_string("\n");
1565 set_string_char(XSTRING(string), 0,
1566 DOWNCASE(current_buffer,
1567 string_char(XSTRING(string), 0)));
1568 return concat2(string, string2);
1569 } else if (EQ(symbol, Qexit)) {
1571 return build_translated_string("finished\n");
1572 string = Fnumber_to_string(make_int(code));
1574 string2 = build_translated_string(" (core dumped)\n");
1576 string2 = build_string("\n");
1578 concat2(build_translated_string
1579 ("exited abnormally with code "), concat2(string,
1582 return Fcopy_sequence(Fsymbol_name(symbol));
1585 /* Tell status_notify() to check for terminated processes. We do this
1586 because on some systems we sometimes miss SIGCHLD calls. (Not sure
1589 void kick_status_notify(void)
1594 /* Report all recent events of a change in process status
1595 (either run the sentinel or output a message).
1596 This is done while Emacs is waiting for keyboard input. */
1598 void status_notify(void)
1600 /* This function can GC */
1601 Lisp_Object tail = Qnil;
1602 Lisp_Object symbol = Qnil;
1603 Lisp_Object msg = Qnil;
1604 struct gcpro gcpro1, gcpro2, gcpro3;
1605 /* process_tick is volatile, so we have to remember it now.
1606 Otherwise, we get a race condition if SIGCHLD happens during
1609 (Actually, this is not the case anymore. The code to
1610 update the process structures has been moved out of the
1611 SIGCHLD handler. But for the moment I'm leaving this
1612 stuff in -- it can't hurt.) */
1613 int temp_process_tick;
1615 MAYBE_PROCMETH(reap_exited_processes, ());
1617 temp_process_tick = process_tick;
1619 if (update_tick == temp_process_tick)
1622 /* We need to gcpro tail; if read_process_output calls a filter
1623 which deletes a process and removes the cons to which tail points
1624 from Vprocess_alist, and then causes a GC, tail is an unprotected
1626 GCPRO3(tail, symbol, msg);
1628 for (tail = Vprocess_list; CONSP(tail); tail = XCDR(tail)) {
1629 Lisp_Object process = XCAR(tail);
1630 Lisp_Process *p = XPROCESS(process);
1631 /* p->tick is also volatile. Same thing as above applies. */
1632 int this_process_tick;
1634 /* #### extra check for terminated processes, in case a SIGCHLD
1635 got missed (this seems to happen sometimes, I'm not sure why).
1638 MAYBE_PROCMETH(update_status_if_terminated, (p));
1640 this_process_tick = p->tick;
1641 if (this_process_tick != p->update_tick) {
1642 p->update_tick = this_process_tick;
1644 /* If process is still active, read any output that remains. */
1645 while (!EQ(p->filter, Qt)
1646 && read_process_output(process) > 0) ;
1648 /* Get the text to use for the message. */
1649 msg = status_message(p);
1651 /* If process is terminated, deactivate it or delete it. */
1652 symbol = p->status_symbol;
1654 if (EQ(symbol, Qsignal)
1655 || EQ(symbol, Qexit)) {
1656 if (delete_exited_processes)
1657 remove_process(process);
1659 deactivate_process(process);
1662 /* Now output the message suitably. */
1663 if (!NILP(p->sentinel))
1664 exec_sentinel(process, msg);
1665 /* Don't bother with a message in the buffer
1666 when a process becomes runnable. */
1667 else if (!EQ(symbol, Qrun) && !NILP(p->buffer)) {
1668 Lisp_Object old_read_only = Qnil;
1669 Lisp_Object old = Fcurrent_buffer();
1671 struct gcpro ngcpro1, ngcpro2;
1673 /* Avoid error if buffer is deleted
1674 (probably that's why the process is dead, too) */
1675 if (!BUFFER_LIVE_P(XBUFFER(p->buffer)))
1678 NGCPRO2(old, old_read_only);
1679 Fset_buffer(p->buffer);
1680 opoint = BUF_PT(current_buffer);
1681 /* Insert new output into buffer
1682 at the current end-of-output marker,
1683 thus preserving logical ordering of input and output. */
1684 if (XMARKER(p->mark)->buffer)
1685 BUF_SET_PT(current_buffer,
1686 marker_position(p->mark));
1688 BUF_SET_PT(current_buffer,
1689 BUF_ZV(current_buffer));
1690 if (BUF_PT(current_buffer) <= opoint)
1692 (string_char_length(XSTRING(msg))
1694 string_char_length(XSTRING
1698 old_read_only = current_buffer->read_only;
1699 current_buffer->read_only = Qnil;
1700 buffer_insert_c_string(current_buffer,
1702 Finsert(1, &p->name);
1703 buffer_insert_c_string(current_buffer, " ");
1705 current_buffer->read_only = old_read_only;
1706 Fset_marker(p->mark,
1707 make_int(BUF_PT(current_buffer)),
1711 bufpos_clip_to_bounds(BUF_BEGV
1712 (XBUFFER(p->buffer)),
1716 BUF_SET_PT(current_buffer, opoint);
1723 /* in case buffers use %s in modeline-format */
1724 MARK_MODELINE_CHANGED;
1727 update_tick = temp_process_tick;
1732 DEFUN("process-status", Fprocess_status, 1, 1, 0, /*
1733 Return the status of PROCESS.
1734 This is a symbol, one of these:
1736 run -- for a process that is running.
1737 stop -- for a process stopped but continuable.
1738 exit -- for a process that has exited.
1739 signal -- for a process that has got a fatal signal.
1740 open -- for a network stream connection that is open.
1741 closed -- for a network stream connection that is closed.
1742 nil -- if arg is a process name and no such process exists.
1744 PROCESS may be a process, a buffer, the name of a process or buffer, or
1745 nil, indicating the current buffer's process.
1749 Lisp_Object status_symbol;
1751 if (STRINGP(process))
1752 process = Fget_process(process);
1754 process = get_process(process);
1759 status_symbol = XPROCESS(process)->status_symbol;
1760 if (network_connection_p(process)) {
1761 if (EQ(status_symbol, Qrun))
1762 status_symbol = Qopen;
1763 else if (EQ(status_symbol, Qexit))
1764 status_symbol = Qclosed;
1766 return status_symbol;
1769 DEFUN("process-exit-status", Fprocess_exit_status, 1, 1, 0, /*
1770 Return the exit status of PROCESS or the signal number that killed it.
1771 If PROCESS has not yet exited or died, return 0.
1775 CHECK_PROCESS(process);
1776 return make_int(XPROCESS(process)->exit_code);
1779 static int decode_signal(Lisp_Object signal_)
1782 return XINT(signal_);
1786 CHECK_SYMBOL(signal_);
1787 name = string_data(XSYMBOL(signal_)->name);
1789 #define handle_signal(sym) do { \
1790 if (!strcmp ((const char *) name, #sym)) \
1794 handle_signal(SIGINT); /* ANSI */
1795 handle_signal(SIGILL); /* ANSI */
1796 handle_signal(SIGABRT); /* ANSI */
1797 handle_signal(SIGFPE); /* ANSI */
1798 handle_signal(SIGSEGV); /* ANSI */
1799 handle_signal(SIGTERM); /* ANSI */
1802 handle_signal(SIGHUP); /* POSIX */
1805 handle_signal(SIGQUIT); /* POSIX */
1808 handle_signal(SIGTRAP); /* POSIX */
1811 handle_signal(SIGKILL); /* POSIX */
1814 handle_signal(SIGUSR1); /* POSIX */
1817 handle_signal(SIGUSR2); /* POSIX */
1820 handle_signal(SIGPIPE); /* POSIX */
1823 handle_signal(SIGALRM); /* POSIX */
1826 handle_signal(SIGCHLD); /* POSIX */
1829 handle_signal(SIGCONT); /* POSIX */
1832 handle_signal(SIGSTOP); /* POSIX */
1835 handle_signal(SIGTSTP); /* POSIX */
1838 handle_signal(SIGTTIN); /* POSIX */
1841 handle_signal(SIGTTOU); /* POSIX */
1845 handle_signal(SIGBUS); /* XPG5 */
1848 handle_signal(SIGPOLL); /* XPG5 */
1851 handle_signal(SIGPROF); /* XPG5 */
1854 handle_signal(SIGSYS); /* XPG5 */
1857 handle_signal(SIGURG); /* XPG5 */
1860 handle_signal(SIGXCPU); /* XPG5 */
1863 handle_signal(SIGXFSZ); /* XPG5 */
1866 handle_signal(SIGVTALRM); /* XPG5 */
1870 handle_signal(SIGIO); /* BSD 4.2 */
1873 handle_signal(SIGWINCH); /* BSD 4.3 */
1877 handle_signal(SIGEMT);
1880 handle_signal(SIGINFO);
1883 handle_signal(SIGHWE);
1886 handle_signal(SIGPRE);
1889 handle_signal(SIGUME);
1892 handle_signal(SIGDLK);
1895 handle_signal(SIGCPULIM);
1898 handle_signal(SIGIOT);
1901 handle_signal(SIGLOST);
1904 handle_signal(SIGSTKFLT);
1907 handle_signal(SIGUNUSED);
1910 handle_signal(SIGDANGER); /* AIX */
1913 handle_signal(SIGMSG);
1916 handle_signal(SIGSOUND);
1919 handle_signal(SIGRETRACT);
1922 handle_signal(SIGGRANT);
1925 handle_signal(SIGPWR);
1928 #undef handle_signal
1930 error("Undefined signal name %s", name);
1931 return 0; /* Unreached */
1935 /* Send signal number SIGNO to PROCESS.
1936 CURRENT-GROUP non-nil means send signal to the current
1937 foreground process group of the process's controlling terminal rather
1938 than to the process's own process group.
1939 This is used for various commands in shell mode.
1940 If NOMSG is zero, insert signal-announcements into process's buffers
1943 If we can, we try to signal PROCESS by sending control characters
1944 down the pty. This allows us to signal inferiors who have changed
1945 their uid, for which kill() would return an EPERM error, or to
1946 processes running on another computer through a remote login. */
1949 process_send_signal(Lisp_Object process, int signo,
1950 int current_group, int nomsg)
1952 /* This function can GC */
1953 process = get_process(process);
1955 if (network_connection_p(process))
1956 error("Network connection %s is not a subprocess",
1957 XSTRING_DATA(XPROCESS(process)->name));
1958 CHECK_LIVE_PROCESS(process);
1960 MAYBE_PROCMETH(kill_child_process,
1961 (process, signo, current_group, nomsg));
1964 DEFUN("process-send-signal", Fprocess_send_signal, 1, 3, 0, /*
1965 Send signal SIGNAL to process PROCESS.
1966 SIGNAL may be an integer, or a symbol naming a signal, like `SIGSEGV'.
1967 PROCESS may be a process, a buffer, the name of a process or buffer, or
1968 nil, indicating the current buffer's process.
1969 Third arg CURRENT-GROUP non-nil means send signal to the current
1970 foreground process group of the process's controlling terminal rather
1971 than to the process's own process group.
1972 If the process is a shell that supports job control, this means
1973 send the signal to the current subjob rather than the shell.
1975 (signal_, process, current_group))
1977 /* This function can GC */
1978 process_send_signal(process, decode_signal(signal_),
1979 !NILP(current_group), 0);
1983 DEFUN("interrupt-process", Finterrupt_process, 0, 2, 0, /*
1984 Interrupt process PROCESS.
1985 See function `process-send-signal' for more details on usage.
1987 (process, current_group))
1989 /* This function can GC */
1990 process_send_signal(process, SIGINT, !NILP(current_group), 0);
1994 DEFUN("kill-process", Fkill_process, 0, 2, 0, /*
1995 Kill process PROCESS.
1996 See function `process-send-signal' for more details on usage.
1998 (process, current_group))
2000 /* This function can GC */
2002 process_send_signal(process, SIGKILL, !NILP(current_group), 0);
2004 error("kill-process: Not supported on this system");
2009 DEFUN("quit-process", Fquit_process, 0, 2, 0, /*
2010 Send QUIT signal to process PROCESS.
2011 See function `process-send-signal' for more details on usage.
2013 (process, current_group))
2015 /* This function can GC */
2017 process_send_signal(process, SIGQUIT, !NILP(current_group), 0);
2019 error("quit-process: Not supported on this system");
2024 DEFUN("stop-process", Fstop_process, 0, 2, 0, /*
2025 Stop process PROCESS.
2026 See function `process-send-signal' for more details on usage.
2028 (process, current_group))
2030 /* This function can GC */
2032 process_send_signal(process, SIGTSTP, !NILP(current_group), 0);
2034 error("stop-process: Not supported on this system");
2039 DEFUN("continue-process", Fcontinue_process, 0, 2, 0, /*
2040 Continue process PROCESS.
2041 See function `process-send-signal' for more details on usage.
2043 (process, current_group))
2045 /* This function can GC */
2047 process_send_signal(process, SIGCONT, !NILP(current_group), 0);
2049 error("continue-process: Not supported on this system");
2054 DEFUN("signal-process", Fsignal_process, 2, 2, "nProcess number: \nnSignal code: ", /*
2055 Send the process with process id PID the signal with code SIGNAL.
2056 PID must be an integer. The process need not be a child of this Emacs.
2057 SIGNAL may be an integer, or a symbol naming a signal, like `SIGSEGV'.
2063 return make_int(PROCMETH_OR_GIVEN(kill_process_by_pid,
2064 (XINT(pid), decode_signal(signal_)),
2068 DEFUN("process-send-eof", Fprocess_send_eof, 0, 1, 0, /*
2069 Make PROCESS see end-of-file in its input.
2070 PROCESS may be a process, a buffer, the name of a process or buffer, or
2071 nil, indicating the current buffer's process.
2072 If PROCESS is a network connection, or is a process communicating
2073 through a pipe (as opposed to a pty), then you cannot send any more
2074 text to PROCESS after you call this function.
2078 /* This function can GC */
2079 process = get_process(process);
2081 /* Make sure the process is really alive. */
2082 if (!EQ(XPROCESS(process)->status_symbol, Qrun))
2083 error("Process %s not running",
2084 XSTRING_DATA(XPROCESS(process)->name));
2086 if (!MAYBE_INT_PROCMETH(process_send_eof, (process))) {
2087 if (!NILP(DATA_OUTSTREAM(XPROCESS(process)))) {
2088 Lstream_close(XLSTREAM
2089 (DATA_OUTSTREAM(XPROCESS(process))));
2090 event_stream_delete_stream_pair(Qnil,
2093 XPROCESS(process)->pipe_outstream = Qnil;
2095 XPROCESS(process)->coding_outstream = Qnil;
2103 /************************************************************************/
2104 /* deleting a process */
2105 /************************************************************************/
2107 void deactivate_process(Lisp_Object process)
2109 Lisp_Process *p = XPROCESS(process);
2112 /* It's possible that we got as far in the process-creation
2113 process as creating the descriptors but didn't get so
2114 far as selecting the process for input. In this
2115 case, p->pid is nil: p->pid is set at the same time that
2116 the process is selected for input. */
2117 /* #### The comment does not look correct. event_stream_unselect_process
2118 is guarded by process->selected, so this is not a problem. - kkm */
2119 /* Must call this before setting the streams to nil */
2120 event_stream_unselect_process(p);
2122 if (!NILP(DATA_OUTSTREAM(p)))
2123 Lstream_close(XLSTREAM(DATA_OUTSTREAM(p)));
2124 if (!NILP(DATA_INSTREAM(p)))
2125 Lstream_close(XLSTREAM(DATA_INSTREAM(p)));
2127 /* Provide minimal implementation for deactivate_process
2128 if there's no process-specific one */
2129 if (HAS_PROCMETH_P(deactivate_process))
2130 usid = PROCMETH(deactivate_process, (p));
2132 usid = event_stream_delete_stream_pair(p->pipe_instream,
2135 if (usid != USID_DONTHASH)
2136 remhash((const void *)usid, usid_to_process);
2138 p->pipe_instream = Qnil;
2139 p->pipe_outstream = Qnil;
2141 p->coding_instream = Qnil;
2142 p->coding_outstream = Qnil;
2146 static void remove_process(Lisp_Object process)
2148 Vprocess_list = delq_no_quit(process, Vprocess_list);
2149 Fset_marker(XPROCESS(process)->mark, Qnil, Qnil);
2151 deactivate_process(process);
2154 DEFUN("delete-process", Fdelete_process, 1, 1, 0, /*
2155 Delete PROCESS: kill it and forget about it immediately.
2156 PROCESS may be a process or the name of one, or a buffer name.
2160 /* This function can GC */
2162 process = get_process(process);
2163 p = XPROCESS(process);
2164 if (network_connection_p(process)) {
2165 p->status_symbol = Qexit;
2170 } else if (PROCESS_LIVE_P(p)) {
2171 Fkill_process(process, Qnil);
2172 /* Do this now, since remove_process will make sigchld_handler do nothing. */
2173 p->status_symbol = Qsignal;
2174 p->exit_code = SIGKILL;
2180 remove_process(process);
2184 /* Kill all processes associated with `buffer'.
2185 If `buffer' is nil, kill all processes */
2187 void kill_buffer_processes(Lisp_Object buffer)
2189 LIST_LOOP_2(process, Vprocess_list)
2190 if ((NILP(buffer) || EQ(XPROCESS(process)->buffer, buffer))) {
2191 if (network_connection_p(process))
2192 Fdelete_process(process);
2193 else if (PROCESS_LIVE_P(XPROCESS(process)))
2194 process_send_signal(process, SIGHUP, 0, 1);
2198 DEFUN("process-kill-without-query", Fprocess_kill_without_query, 1, 2, 0, /*
2199 Say no query needed if PROCESS is running when Emacs is exited.
2200 Optional second argument if non-nil says to require a query.
2201 Value is t if a query was formerly required.
2203 (process, require_query_p))
2207 CHECK_PROCESS(process);
2208 tem = XPROCESS(process)->kill_without_query;
2209 XPROCESS(process)->kill_without_query = NILP(require_query_p);
2211 return tem ? Qnil : Qt;
2214 DEFUN("process-kill-without-query-p", Fprocess_kill_without_query_p, 1, 1, 0, /*
2215 Return t if PROCESS will be killed without query when emacs is exited.
2219 CHECK_PROCESS(process);
2220 return XPROCESS(process)->kill_without_query ? Qt : Qnil;
2224 mark_usid_to_process(Lisp_Object obj)
2226 struct hash_table *ht = get_dynacat(obj);
2231 mark_object((Lisp_Object)ht->zero_entry);
2234 for (e = ht->harray, limit = e + ht->size; e < limit; e++) {
2236 mark_object((Lisp_Object)e->contents);
2240 /* This is not named init_process in order to avoid a conflict with NS 3.3 */
2241 void init_sxemacs_process(void)
2243 MAYBE_PROCMETH(init_process, ());
2245 Vprocess_list = Qnil;
2247 if (usid_to_process) {
2248 clrhash(usid_to_process);
2251 usid_to_process = make_hash_table(32);
2252 Vusid_to_process = make_dynacat(usid_to_process);
2253 set_dynacat_marker(Vusid_to_process, mark_usid_to_process);
2257 void syms_of_process(void)
2259 INIT_LRECORD_IMPLEMENTATION(process);
2261 defsymbol(&Qprocessp, "processp");
2262 defsymbol(&Qprocess_live_p, "process-live-p");
2264 /* see comment at Fprocess_readable_p */
2265 defsymbol(&Qprocess_readable_p, "process-readable-p");
2267 defsymbol(&Qrun, "run");
2268 defsymbol(&Qstop, "stop");
2269 defsymbol(&Qopen, "open");
2270 defsymbol(&Qclosed, "closed");
2272 defsymbol(&Qtcp, "tcp");
2273 defsymbol(&Qudp, "udp");
2275 #ifdef HAVE_MULTICAST
2276 defsymbol(&Qmulticast, "multicast"); /* Used for occasional warnings */
2280 DEFSUBR(Fprocess_live_p);
2282 /* see comment at Fprocess_readable_p */
2283 DEFSUBR(Fprocess_readable_p);
2285 DEFSUBR(Fget_process);
2286 DEFSUBR(Fget_buffer_process);
2287 DEFSUBR(Fdelete_process);
2288 DEFSUBR(Fprocess_status);
2289 DEFSUBR(Fprocess_exit_status);
2290 DEFSUBR(Fprocess_id);
2291 DEFSUBR(Fprocess_name);
2292 DEFSUBR(Fprocess_tty_name);
2293 DEFSUBR(Fprocess_command);
2294 DEFSUBR(Fset_process_buffer);
2295 DEFSUBR(Fprocess_buffer);
2296 DEFSUBR(Fprocess_mark);
2297 DEFSUBR(Fset_process_filter);
2298 DEFSUBR(Fprocess_filter);
2299 DEFSUBR(Fprocess_type_data);
2300 DEFSUBR(Fset_process_window_size);
2301 DEFSUBR(Fset_process_sentinel);
2302 DEFSUBR(Fprocess_sentinel);
2303 DEFSUBR(Fprocess_kill_without_query);
2304 DEFSUBR(Fprocess_kill_without_query_p);
2305 DEFSUBR(Fprocess_list);
2306 DEFSUBR(Fstart_process_internal);
2308 defsymbol(&Qip_any, "ip_any");
2309 defsymbol(&Qlocalhost, "localhost");
2310 DEFSUBR(Fopen_network_stream_internal);
2311 DEFSUBR(Fopen_network_server_stream_internal);
2312 DEFSUBR(Fnetwork_process_listener);
2313 #ifdef HAVE_MULTICAST
2314 DEFSUBR(Fopen_multicast_group_internal);
2315 #endif /* HAVE_MULTICAST */
2316 #endif /* HAVE_SOCKETS */
2317 DEFSUBR(Fconnect_file_descriptor);
2318 DEFSUBR(Fprocess_send_region);
2319 DEFSUBR(Fprocess_send_string);
2320 DEFSUBR(Fprocess_send_signal);
2321 DEFSUBR(Finterrupt_process);
2322 DEFSUBR(Fkill_process);
2323 DEFSUBR(Fquit_process);
2324 DEFSUBR(Fstop_process);
2325 DEFSUBR(Fcontinue_process);
2326 DEFSUBR(Fprocess_send_eof);
2327 DEFSUBR(Fsignal_process);
2328 /* DEFSUBR (Fprocess_connection); */
2330 DEFSUBR(Fprocess_input_coding_system);
2331 DEFSUBR(Fprocess_output_coding_system);
2332 DEFSUBR(Fset_process_input_coding_system);
2333 DEFSUBR(Fset_process_output_coding_system);
2334 DEFSUBR(Fprocess_coding_system);
2335 DEFSUBR(Fset_process_coding_system);
2336 #endif /* FILE_CODING */
2339 void vars_of_process(void)
2341 Fprovide(intern("subprocesses"));
2343 Fprovide(intern("network-streams"));
2344 #ifdef HAVE_MULTICAST
2345 Fprovide(intern("multicast"));
2346 #endif /* HAVE_MULTICAST */
2347 #endif /* HAVE_SOCKETS */
2348 staticpro(&Vprocess_list);
2349 staticpro(&Vusid_to_process);
2351 DEFVAR_BOOL("delete-exited-processes", &delete_exited_processes /*
2352 *Non-nil means delete processes immediately when they exit.
2353 nil means don't delete them until `list-processes' is run.
2356 delete_exited_processes = 1;
2358 DEFVAR_CONST_LISP("null-device", &Vnull_device /*
2359 Name of the null device, which differs from system to system.
2360 The null device is a filename that acts as a sink for arbitrary amounts of
2361 data, which is discarded, or as a source for a zero-length file.
2362 It is available on all the systems that we currently support, but with
2363 different names (typically either `/dev/null' or `nul').
2365 Note that there is also a /dev/zero on most modern Unix versions,
2366 which acts like /dev/null when used as a sink, but as a source it
2367 sends a non-ending stream of zero bytes. It's used most often along
2368 with memory-mapping. We don't provide a Lisp variable for this
2369 because the operations needing this are lower level than what ELisp
2370 programs typically do.
2372 Vnull_device = build_string(NULL_DEVICE);
2374 DEFVAR_LISP("process-connection-type", &Vprocess_connection_type /*
2375 Control type of device used to communicate with subprocesses.
2376 Values are nil to use a pipe, or t or `pty' to use a pty.
2377 The value has no effect if the system has no ptys or if all ptys are busy:
2378 then a pipe is used in any case.
2379 The value takes effect when `start-process' is called.
2381 Vprocess_connection_type = Qt;
2383 DEFVAR_BOOL("windowed-process-io", &windowed_process_io /*
2384 Enables input/output on standard handles of a windowed process.
2385 When this variable is nil (the default), SXEmacs does not attempt to read
2386 standard output handle of a windowed process. Instead, the process is
2387 immediately marked as exited immediately upon successful launching. This is
2388 done because normal windowed processes do not use standard I/O, as they are
2389 not connected to any console.
2391 When launching a specially crafted windowed process, which expects to be
2392 launched by SXEmacs, or by other program which pipes its standard input and
2393 output, this variable must be set to non-nil, in which case SXEmacs will
2394 treat this process just like a console process.
2396 NOTE: You should never set this variable, only bind it.
2398 Only Windows processes can be "windowed" or "console". This variable has no
2399 effect on UNIX processes, because all UNIX processes are "console".
2401 windowed_process_io = 0;
2403 #ifdef PROCESS_IO_BLOCKING
2404 DEFVAR_LISP("network-stream-blocking-port-list", &network_stream_blocking_port_list /*
2405 List of port numbers or port names to set a blocking I/O mode with connection.
2406 Nil value means to set a default(non-blocking) I/O mode.
2407 The value takes effect when `open-network-stream-internal' is called.
2409 network_stream_blocking_port_list = Qnil;
2410 #endif /* PROCESS_IO_BLOCKING */
2413 #endif /* not NO_SUBPROCESSES */