1 /* Asynchronous subprocess control for XEmacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993, 1994, 1995
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 XEmacs.
9 XEmacs is free software; you can redistribute it and/or modify it
10 under the terms of the GNU General Public License as published by the
11 Free Software Foundation; either version 2, or (at your option) any
14 XEmacs is distributed in the hope that it will be useful, but WITHOUT
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
19 You should have received a copy of the GNU General Public License
20 along with XEmacs; see the file COPYING. If not, write to
21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 Boston, MA 02111-1307, USA. */
24 /* This file has been Mule-ized except for `start-process-internal',
25 `open-network-stream-internal' and `open-multicast-group-internal'. */
27 /* This file has been split into process.c and process-unix.c by
28 Kirill M. Katsnelson <kkm@kis.ru>, so please bash him and not
29 the original author(s) */
33 #if !defined (NO_SUBPROCESSES)
35 /* The entire file is within this conditional */
51 #include "file-coding.h"
57 #include "syssignal.h" /* Always include before systty.h */
61 Lisp_Object Qprocessp, Qprocess_live_p, Qprocess_readable_p;
64 struct process_methods the_process_methods;
66 /* a process object is a network connection when its pid field a cons
67 (name of name of port we are connected to . foreign host name) */
69 /* Valid values of process->status_symbol */
70 Lisp_Object Qrun, Qstop;
71 /* Qrun => Qopen, Qexit => Qclosed for "network connection" processes */
72 Lisp_Object Qopen, Qclosed;
73 /* Protocol families */
74 Lisp_Object Qtcp, Qudp;
77 Lisp_Object Qmulticast; /* Will be used for occasional warnings */
80 /* t means use pty, nil means use a pipe,
81 maybe other values to come. */
82 Lisp_Object Vprocess_connection_type;
84 /* Read comments to DEFVAR of this */
85 int windowed_process_io;
87 #ifdef PROCESS_IO_BLOCKING
88 /* List of port numbers or port names to set a blocking I/O mode.
89 Nil means set a non-blocking I/O mode [default]. */
90 Lisp_Object network_stream_blocking_port_list;
91 #endif /* PROCESS_IO_BLOCKING */
93 /* Number of events of change of status of a process. */
94 volatile int process_tick;
96 /* Number of events for which the user or sentinel has been notified. */
97 static int update_tick;
99 /* Nonzero means delete a process right away if it exits. */
100 int delete_exited_processes;
102 /* Hash table which maps USIDs as returned by create_stream_pair_cb to
103 process objects. Processes are not GC-protected through this! */
104 struct hash_table *usid_to_process;
106 /* List of process objects. */
107 Lisp_Object Vprocess_list;
109 extern Lisp_Object Vlisp_EXEC_SUFFIXES;
110 Lisp_Object Vnull_device;
115 mark_process (Lisp_Object object)
117 Lisp_Process *process = XPROCESS (object);
118 MAYBE_PROCMETH (mark_process_data, (process));
119 mark_object (process->name);
120 mark_object (process->command);
121 mark_object (process->filter);
122 mark_object (process->sentinel);
123 mark_object (process->buffer);
124 mark_object (process->mark);
125 mark_object (process->pid);
126 mark_object (process->pipe_instream);
127 mark_object (process->pipe_outstream);
129 mark_object (process->coding_instream);
130 mark_object (process->coding_outstream);
132 return process->status_symbol;
136 print_process (Lisp_Object object, Lisp_Object printcharfun, int escapeflag)
138 Lisp_Process *process = XPROCESS (object);
141 error ("printing unreadable object #<process %s>",
142 XSTRING_DATA (process->name));
146 print_internal (process->name, printcharfun, 0);
150 int netp = network_connection_p (object);
151 write_c_string ((netp ? GETTEXT ("#<network connection ") :
152 GETTEXT ("#<process ")), printcharfun);
153 print_internal (process->name, printcharfun, 1);
154 write_c_string ((netp ? " " : " pid "), printcharfun);
155 print_internal (process->pid, printcharfun, 1);
156 write_c_string (" state:", printcharfun);
157 print_internal (process->status_symbol, printcharfun, 1);
158 MAYBE_PROCMETH (print_process_data, (process, printcharfun));
159 write_c_string (">", printcharfun);
163 #ifdef HAVE_WINDOW_SYSTEM
164 extern void debug_process_finalization (Lisp_Process *p);
165 #endif /* HAVE_WINDOW_SYSTEM */
168 finalize_process (void *header, int for_disksave)
170 /* #### this probably needs to be tied into the tty event loop */
171 /* #### when there is one */
172 Lisp_Process *p = (Lisp_Process *) header;
173 #ifdef HAVE_WINDOW_SYSTEM
176 debug_process_finalization (p);
178 #endif /* HAVE_WINDOW_SYSTEM */
182 MAYBE_PROCMETH (finalize_process_data, (p, for_disksave));
184 xfree (p->process_data);
188 DEFINE_LRECORD_IMPLEMENTATION ("process", process,
189 mark_process, print_process, finalize_process,
190 0, 0, 0, Lisp_Process);
192 /************************************************************************/
193 /* basic process accessors */
194 /************************************************************************/
196 /* Under FILE_CODING, this function returns low-level streams, connected
197 directly to the child process, rather than en/decoding FILE_CODING
200 get_process_streams (Lisp_Process *p, Lisp_Object *instr, Lisp_Object *outstr)
203 assert (NILP (p->pipe_instream) || LSTREAMP(p->pipe_instream));
204 assert (NILP (p->pipe_outstream) || LSTREAMP(p->pipe_outstream));
205 *instr = p->pipe_instream;
206 *outstr = p->pipe_outstream;
210 get_process_from_usid (USID usid)
214 assert (usid != USID_ERROR && usid != USID_DONTHASH);
216 if (gethash ((const void*)usid, usid_to_process, &vval))
219 CVOID_TO_LISP (process, vval);
220 return XPROCESS (process);
227 get_process_selected_p (Lisp_Process *p)
233 set_process_selected_p (Lisp_Process *p, int selected_p)
235 p->selected = !!selected_p;
239 connected_via_filedesc_p (Lisp_Process *p)
241 return MAYBE_INT_PROCMETH (tooltalk_connection_p, (p));
246 network_connection_p (Lisp_Object process)
248 return CONSP (XPROCESS (process)->pid);
252 DEFUN ("processp", Fprocessp, 1, 1, 0, /*
253 Return t if OBJECT is a process.
257 return PROCESSP (object) ? Qt : Qnil;
260 DEFUN ("process-live-p", Fprocess_live_p, 1, 1, 0, /*
261 Return t if OBJECT is a process that is alive.
265 return PROCESSP (object) && PROCESS_LIVE_P (XPROCESS (object))
270 /* This is a reasonable definition for this new primitive. Kyle sez:
272 "The patch looks OK to me except for the creation and exporting of the
273 Fprocess_readable_p function. I don't think a new Lisp function
274 should be created until we know something actually needs it. If
275 we later want to give process-readable-p different semantics it
276 may be hard to do it and stay compatible with what we hastily
279 He's right, not yet. Let's discuss the semantics on XEmacs Design
280 before enabling this.
282 DEFUN ("process-readable-p", Fprocess_readable_p, 1, 1, 0, /*
283 Return t if OBJECT is a process from which input may be available.
287 return PROCESSP (object) && PROCESS_READABLE_P (XPROCESS (object))
292 DEFUN ("process-list", Fprocess_list, 0, 0, 0, /*
293 Return a list of all processes.
297 return Fcopy_sequence (Vprocess_list);
300 DEFUN ("get-process", Fget_process, 1, 1, 0, /*
301 Return the process named PROCESS-NAME (a string), or nil if there is none.
302 PROCESS-NAME may also be a process; if so, the value is that process.
306 if (PROCESSP (process_name))
310 /* this only gets called during GC when emacs is going away as a result
311 of a signal or crash. */
312 CHECK_STRING (process_name);
315 LIST_LOOP_2 (process, Vprocess_list)
316 if (internal_equal (process_name, XPROCESS (process)->name, 0))
322 DEFUN ("get-buffer-process", Fget_buffer_process, 1, 1, 0, /*
323 Return the (or, a) process associated with BUFFER.
324 BUFFER may be a buffer or the name of one.
328 if (NILP (buffer)) return Qnil;
329 buffer = Fget_buffer (buffer);
330 if (NILP (buffer)) return Qnil;
333 LIST_LOOP_2 (process, Vprocess_list)
334 if (EQ (XPROCESS (process)->buffer, buffer))
340 /* This is how commands for the user decode process arguments. It
341 accepts a process, a process name, a buffer, a buffer name, or nil.
342 Buffers denote the first process in the buffer, and nil denotes the
346 get_process (Lisp_Object name)
351 /* #### Look more closely into translating process names. */
354 /* This may be called during a GC from process_send_signal() from
355 kill_buffer_processes() if emacs decides to abort(). */
358 else if (STRINGP (name))
360 Lisp_Object object = Fget_process (name);
361 if (PROCESSP (object))
364 buffer = Fget_buffer (name);
365 if (BUFFERP (buffer))
366 goto have_buffer_object;
368 error ("Process %s does not exist", XSTRING_DATA (name));
370 else if (NILP (name))
372 buffer = Fcurrent_buffer ();
373 goto have_buffer_object;
375 else if (BUFFERP (name))
381 process = Fget_buffer_process (buffer);
382 if (PROCESSP (process))
385 error ("Buffer %s has no process",
386 XSTRING_DATA (XBUFFER (buffer)->name));
389 return get_process (Fsignal (Qwrong_type_argument,
390 (list2 (build_string ("process or buffer or nil"),
394 DEFUN ("process-id", Fprocess_id, 1, 1, 0, /*
395 Return the process id of PROCESS.
396 This is the pid of the Unix process which PROCESS uses or talks to.
397 For a network connection, this value is a cons of
398 (foreign-network-port . foreign-host-name).
403 CHECK_PROCESS (process);
405 pid = XPROCESS (process)->pid;
406 if (network_connection_p (process))
408 return Fcons (Fcar (pid), Fcdr (pid));
413 DEFUN ("process-name", Fprocess_name, 1, 1, 0, /*
414 Return the name of PROCESS, as a string.
415 This is the name of the program invoked in PROCESS,
416 possibly modified to make it unique among process names.
420 CHECK_PROCESS (process);
421 return XPROCESS (process)->name;
424 DEFUN ("process-command", Fprocess_command, 1, 1, 0, /*
425 Return the command that was executed to start PROCESS.
426 This is a list of strings, the first string being the program executed
427 and the rest of the strings being the arguments given to it.
431 CHECK_PROCESS (process);
432 return XPROCESS (process)->command;
436 /************************************************************************/
437 /* creating a process */
438 /************************************************************************/
441 make_process_internal (Lisp_Object name)
443 Lisp_Object val, name1;
445 Lisp_Process *p = alloc_lcrecord_type (Lisp_Process, &lrecord_process);
447 /* If name is already in use, modify it until it is unused. */
452 Lisp_Object tem = Fget_process (name1);
455 sprintf (suffix, "<%d>", i);
456 name1 = concat2 (name, build_string (suffix));
465 p->mark = Fmake_marker ();
467 p->status_symbol = Qrun;
470 p->filter_does_read = 0;
471 p->kill_without_query = 0;
475 p->pipe_instream = Qnil;
476 p->pipe_outstream = Qnil;
478 p->coding_instream = Qnil;
479 p->coding_outstream = Qnil;
483 MAYBE_PROCMETH (alloc_process_data, (p));
485 XSETPROCESS (val, p);
487 Vprocess_list = Fcons (val, Vprocess_list);
492 init_process_io_handles (Lisp_Process *p, void* in, void* out, int flags)
494 USID usid = event_stream_create_stream_pair (in, out,
495 &p->pipe_instream, &p->pipe_outstream,
498 if (usid == USID_ERROR)
499 report_file_error ("Setting up communication with subprocess", Qnil);
501 if (usid != USID_DONTHASH)
503 Lisp_Object process = Qnil;
504 XSETPROCESS (process, p);
505 puthash ((const void*)usid, LISP_TO_VOID (process), usid_to_process);
508 MAYBE_PROCMETH (init_process_io_handles, (p, in, out, flags));
511 p->coding_instream = make_decoding_input_stream
512 (XLSTREAM (p->pipe_instream),
513 Fget_coding_system (Vcoding_system_for_read));
514 Lstream_set_character_mode (XLSTREAM (p->coding_instream));
515 p->coding_outstream = make_encoding_output_stream
516 (XLSTREAM (p->pipe_outstream),
517 Fget_coding_system (Vcoding_system_for_write));
518 /* CODE_CNTL (&out_state[outchannel]) |= CC_END; !!####
519 What's going on here? */
520 #endif /* FILE_CODING */
524 create_process (Lisp_Object process, Lisp_Object *argv, int nargv,
525 Lisp_Object program, Lisp_Object cur_dir)
527 Lisp_Process *p = XPROCESS (process);
530 /* *_create_process may change status_symbol, if the process
531 is a kind of "fire-and-forget" (no I/O, unwaitable) */
532 p->status_symbol = Qrun;
535 pid = PROCMETH (create_process, (p, argv, nargv, program, cur_dir));
537 p->pid = make_int (pid);
538 if (PROCESS_READABLE_P (p))
539 event_stream_select_process (p);
542 /* This function is the unwind_protect form for Fstart_process_internal. If
543 PROCESS doesn't have its pid set, then we know someone has signalled
544 an error and the process wasn't started successfully, so we should
545 remove it from the process list. */
546 static void remove_process (Lisp_Object process);
548 start_process_unwind (Lisp_Object process)
550 /* Was PROCESS started successfully? */
551 if (EQ (XPROCESS (process)->pid, Qnil))
552 remove_process (process);
556 DEFUN ("start-process-internal", Fstart_process_internal, 3, MANY, 0, /*
557 Start a program in a subprocess. Return the process object for it.
558 Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS
559 NAME is name for process. It is modified if necessary to make it unique.
560 BUFFER is the buffer or (buffer-name) to associate with the process.
561 Process output goes at end of that buffer, unless you specify
562 an output stream or filter function to handle the output.
563 BUFFER may be also nil, meaning that this process is not associated
565 Third arg is program file name. It is searched for as in the shell.
566 Remaining arguments are strings to give program as arguments.
567 INCODE and OUTCODE specify the coding-system objects used in input/output
570 (int nargs, Lisp_Object *args))
572 /* This function can call lisp */
573 /* !!#### This function has not been Mule-ized */
574 Lisp_Object buffer, name, program, process, current_dir;
577 int speccount = specpdl_depth ();
578 struct gcpro gcpro1, gcpro2, gcpro3;
585 /* Protect against various file handlers doing GCs below. */
586 GCPRO3 (buffer, program, current_dir);
589 buffer = Fget_buffer_create (buffer);
592 CHECK_STRING (program);
593 for (i = 3; i < nargs; ++i)
594 CHECK_STRING (args[i]);
596 /* Make sure that the child will be able to chdir to the current
597 buffer's current directory, or its unhandled equivalent. We
598 can't just have the child check for an error when it does the
599 chdir, since it's in a vfork.
601 Note: these assignments and calls are like this in order to insure
602 "caller protects args" GC semantics. */
603 current_dir = current_buffer->directory;
604 current_dir = Funhandled_file_name_directory (current_dir);
605 current_dir = expand_and_dir_to_file (current_dir, Qnil);
607 #if 0 /* This loser breaks ange-ftp */
608 /* dmoore - if you re-enable this code, you have to gcprotect
609 current_buffer through the above calls. */
610 if (NILP (Ffile_accessible_directory_p (current_dir)))
611 report_file_error ("Setting current directory",
612 list1 (current_buffer->directory));
615 /* If program file name is not absolute, search our path for it */
616 if (!IS_DIRECTORY_SEP (XSTRING_BYTE (program, 0))
617 && !(XSTRING_LENGTH (program) > 1
618 && IS_DEVICE_SEP (XSTRING_BYTE (program, 1))))
620 struct gcpro ngcpro1;
624 locate_file (Vexec_path, program, Vlisp_EXEC_SUFFIXES, &tem, X_OK);
626 report_file_error ("Searching for program", list1 (program));
627 program = Fexpand_file_name (tem, Qnil);
632 /* we still need to canonicalize it and ensure it has the proper
634 struct gcpro ngcpro1;
638 locate_file (list1 (build_string ("")), program, Vlisp_EXEC_SUFFIXES,
641 report_file_error ("Searching for program", list1 (program));
646 if (!NILP (Ffile_directory_p (program)))
647 invalid_operation ("Specified program for new process is a directory",
650 process = make_process_internal (name);
652 XPROCESS (process)->buffer = buffer;
653 XPROCESS (process)->command = Flist (nargs - 2,
656 /* Make the process marker point into the process buffer (if any). */
658 Fset_marker (XPROCESS (process)->mark,
659 make_int (BUF_ZV (XBUFFER (buffer))), buffer);
661 /* If an error occurs and we can't start the process, we want to
662 remove it from the process list. This means that each error
663 check in create_process doesn't need to call remove_process
664 itself; it's all taken care of here. */
665 record_unwind_protect (start_process_unwind, process);
667 create_process (process, args + 3, nargs - 3, program, current_dir);
670 return unbind_to (speccount, process);
677 /* #### The network support is fairly synthetical. What we actually
678 need is a single function, which supports all datagram, stream and
679 packet stream connections, arbitrary protocol families should they
680 be supported by the target system, multicast groups, in both data
681 and control rooted/nonrooted flavors, service quality etc whatever
682 is supported by the underlying network.
684 It must accept a property list describing the connection. The current
685 functions must then go to lisp and provide a suitable list for the
686 generalized connection function.
688 Both UNIX and Win32 support BSD sockets, and there are many extensions
689 available (Sockets 2 spec).
691 A todo is define a consistent set of properties abstracting a
692 network connection. -kkm
696 /* open a TCP network connection to a given HOST/SERVICE. Treated
697 exactly like a normal process when reading and writing. Only
698 differences are in status display and process deletion. A network
699 connection has no PID; you cannot signal it. All you can do is
700 deactivate and close it via delete-process */
702 DEFUN ("open-network-stream-internal", Fopen_network_stream_internal, 4, 5,
704 Open a TCP connection for a service to a host.
705 Return a process object to represent the connection.
706 Input and output work as for subprocesses; `delete-process' closes it.
708 NAME is name for process. It is modified if necessary to make it unique.
709 BUFFER is the buffer (or buffer-name) to associate with the process.
710 Process output goes at end of that buffer, unless you specify
711 an output stream or filter function to handle the output.
712 BUFFER may also be nil, meaning that this process is not associated
714 Third arg HOST (a string) is the name of the host to connect to,
716 Fourth arg SERVICE is the name of the service desired (a string),
717 or an integer specifying a port number to connect to.
718 Optional fifth arg PROTOCOL is a network protocol. Currently only 'tcp
719 (Transmission Control Protocol) and 'udp (User Datagram Protocol) are
720 supported. When omitted, 'tcp is assumed.
722 Output via `process-send-string' and input via buffer or filter (see
723 `set-process-filter') are stream-oriented. That means UDP datagrams are
724 not guaranteed to be sent and received in discrete packets. (But small
725 datagrams around 500 bytes that are not truncated by `process-send-string'
726 are usually fine.) Note further that the UDP protocol does not guard
727 against lost packets.
729 (name, buffer, host, service, protocol))
731 /* !!#### This function has not been Mule-ized */
732 /* This function can GC */
733 Lisp_Object process = Qnil;
734 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, ngcpro1;
737 GCPRO5 (name, buffer, host, service, protocol);
743 CHECK_SYMBOL (protocol);
745 /* Since this code is inside HAVE_SOCKETS, existence of
746 open_network_stream is mandatory */
747 PROCMETH (open_network_stream, (name, host, service, protocol,
751 buffer = Fget_buffer_create (buffer);
752 process = make_process_internal (name);
755 XPROCESS (process)->pid = Fcons (service, host);
756 XPROCESS (process)->buffer = buffer;
757 init_process_io_handles (XPROCESS (process), (void*)inch, (void*)outch,
758 STREAM_NETWORK_CONNECTION);
760 event_stream_select_process (XPROCESS (process));
767 #ifdef HAVE_MULTICAST
769 DEFUN ("open-multicast-group-internal", Fopen_multicast_group_internal, 5, 5, 0, /*
770 Open a multicast connection on the specified dest/port/ttl.
771 Return a process object to represent the connection.
772 Input and output work as for subprocesses; `delete-process' closes it.
774 NAME is name for process. It is modified if necessary to make it unique.
775 BUFFER is the buffer (or buffer-name) to associate with the process.
776 Process output goes at end of that buffer, unless you specify
777 an output stream or filter function to handle the output.
778 BUFFER may also be nil, meaning that this process is not associated
780 Third, fourth and fifth args are the multicast destination group, port and ttl.
781 dest must be an internet address between 224.0.0.0 and 239.255.255.255
782 port is a communication port like in traditional unicast
783 ttl is the time-to-live (15 for site, 63 for region and 127 for world)
785 (name, buffer, dest, port, ttl))
787 /* !!#### This function has not been Mule-ized */
788 /* This function can GC */
789 Lisp_Object process = Qnil;
795 /* Since this code is inside HAVE_MULTICAST, existence of
796 open_network_stream is mandatory */
797 PROCMETH (open_multicast_group, (name, dest, port, ttl,
801 buffer = Fget_buffer_create (buffer);
803 process = make_process_internal (name);
806 XPROCESS (process)->pid = Fcons (port, dest);
807 XPROCESS (process)->buffer = buffer;
808 init_process_io_handles (XPROCESS (process), (void*)inch, (void*)outch,
809 STREAM_NETWORK_CONNECTION);
811 event_stream_select_process (XPROCESS (process));
816 #endif /* HAVE_MULTICAST */
818 #endif /* HAVE_SOCKETS */
821 canonicalize_host_name (Lisp_Object host)
823 return PROCMETH_OR_GIVEN (canonicalize_host_name, (host), host);
827 DEFUN ("set-process-window-size", Fset_process_window_size, 3, 3, 0, /*
828 Tell PROCESS that it has logical window size HEIGHT and WIDTH.
830 (process, height, width))
832 CHECK_PROCESS (process);
833 CHECK_NATNUM (height);
834 CHECK_NATNUM (width);
836 MAYBE_INT_PROCMETH (set_window_size,
837 (XPROCESS (process), XINT (height), XINT (width))) <= 0
842 /************************************************************************/
844 /************************************************************************/
846 /* Read pending output from the process channel,
847 starting with our buffered-ahead character if we have one.
848 Yield number of characters read.
850 This function reads at most 1024 bytes.
851 If you want to read all available subprocess output,
852 you must call it repeatedly until it returns zero. */
855 read_process_output (Lisp_Object process)
857 /* This function can GC */
858 Bytecount nbytes, nchars;
860 Lisp_Object outstream;
861 Lisp_Process *p = XPROCESS (process);
863 /* If there is a lot of output from the subprocess, the loop in
864 execute_internal_event() might call read_process_output() more
865 than once. If the filter that was executed from one of these
866 calls set the filter to t, we have to stop now. Return -1 rather
867 than 0 so execute_internal_event() doesn't close the process.
868 Really, the loop in execute_internal_event() should check itself
869 for a process-filter change, like in status_notify(); but the
870 struct Lisp_Process is not exported outside of this file. */
871 if (!PROCESS_READABLE_P (p))
872 return -1; /* already closed */
874 if (!NILP (p->filter) && (p->filter_does_read))
876 Lisp_Object filter_result;
878 /* Some weird FSFmacs crap here with
879 Vdeactivate_mark and current_buffer->keymap */
880 running_asynch_code = 1;
881 filter_result = call2_trapping_errors ("Error in process filter",
882 p->filter, process, Qnil);
883 running_asynch_code = 0;
884 restore_match_data ();
885 CHECK_INT (filter_result);
886 return XINT (filter_result);
889 nbytes = Lstream_read (XLSTREAM (DATA_INSTREAM(p)), chars, sizeof (chars));
890 if (nbytes <= 0) return nbytes;
892 nchars = bytecount_to_charcount (chars, nbytes);
893 outstream = p->filter;
894 if (!NILP (outstream))
896 /* We used to bind inhibit-quit to t here, but
897 call2_trapping_errors() does that for us. */
898 running_asynch_code = 1;
899 call2_trapping_errors ("Error in process filter",
900 outstream, process, make_string (chars, nbytes));
901 running_asynch_code = 0;
902 restore_match_data ();
906 /* If no filter, write into buffer if it isn't dead. */
907 if (!NILP (p->buffer) && BUFFER_LIVE_P (XBUFFER (p->buffer)))
909 Lisp_Object old_read_only = Qnil;
913 int old_zmacs_region_stays = zmacs_region_stays;
914 struct gcpro gcpro1, gcpro2;
915 struct buffer *buf = XBUFFER (p->buffer);
917 GCPRO2 (process, old_read_only);
919 old_point = BUF_PT (buf);
920 old_begv = BUF_BEGV (buf);
921 old_zv = BUF_ZV (buf);
922 old_read_only = buf->read_only;
923 buf->read_only = Qnil;
925 /* Insert new output into buffer
926 at the current end-of-output marker,
927 thus preserving logical ordering of input and output. */
928 if (XMARKER (p->mark)->buffer)
930 bufpos_clip_to_bounds (old_begv, marker_position (p->mark),
933 BUF_SET_PT (buf, old_zv);
935 /* If the output marker is outside of the visible region, save
936 the restriction and widen. */
937 if (! (BUF_BEGV (buf) <= BUF_PT (buf) &&
938 BUF_PT (buf) <= BUF_ZV (buf)))
941 /* Make sure opoint floats ahead of any new text, just as point
943 if (BUF_PT (buf) <= old_point)
946 /* Insert after old_begv, but before old_zv. */
947 if (BUF_PT (buf) < old_begv)
949 if (BUF_PT (buf) <= old_zv)
953 /* This screws up initial display of the window. jla */
955 /* Insert before markers in case we are inserting where
956 the buffer's mark is, and the user's next command is Meta-y. */
957 buffer_insert_raw_string_1 (buf, -1, chars,
958 nbytes, INSDEL_BEFORE_MARKERS);
960 buffer_insert_raw_string (buf, chars, nbytes);
963 Fset_marker (p->mark, make_int (BUF_PT (buf)), p->buffer);
965 MARK_MODELINE_CHANGED;
967 /* If the restriction isn't what it should be, set it. */
968 if (old_begv != BUF_BEGV (buf) || old_zv != BUF_ZV (buf))
971 old_begv = bufpos_clip_to_bounds (BUF_BEG (buf),
974 old_zv = bufpos_clip_to_bounds (BUF_BEG (buf),
977 Fnarrow_to_region (make_int (old_begv), make_int (old_zv),
981 /* Handling the process output should not deactivate the mark. */
982 zmacs_region_stays = old_zmacs_region_stays;
983 buf->read_only = old_read_only;
984 old_point = bufpos_clip_to_bounds (BUF_BEGV (buf),
987 BUF_SET_PT (buf, old_point);
994 /* Sending data to subprocess */
996 /* send some data to process PROCESS. If NONRELOCATABLE is non-NULL, it
997 specifies the address of the data. Otherwise, the data comes from the
998 object RELOCATABLE (either a string or a buffer). START and LEN
999 specify the offset and length of the data to send.
1001 Note that START and LEN are in Bufpos's if RELOCATABLE is a buffer,
1002 and in Bytecounts otherwise. */
1005 send_process (Lisp_Object process,
1006 Lisp_Object relocatable, const Bufbyte *nonrelocatable,
1009 /* This function can GC */
1010 struct gcpro gcpro1, gcpro2;
1011 Lisp_Object lstream = Qnil;
1013 GCPRO2 (process, lstream);
1015 if (NILP (DATA_OUTSTREAM (XPROCESS (process))))
1016 signal_simple_error ("Process not open for writing", process);
1020 make_fixed_buffer_input_stream (nonrelocatable + start, len);
1021 else if (BUFFERP (relocatable))
1022 lstream = make_lisp_buffer_input_stream (XBUFFER (relocatable),
1023 start, start + len, 0);
1025 lstream = make_lisp_string_input_stream (relocatable, start, len);
1027 PROCMETH (send_process, (process, XLSTREAM (lstream)));
1030 Lstream_delete (XLSTREAM (lstream));
1033 DEFUN ("process-tty-name", Fprocess_tty_name, 1, 1, 0, /*
1034 Return the name of the terminal PROCESS uses, or nil if none.
1035 This is the terminal that the process itself reads and writes on,
1036 not the name of the pty that Emacs uses to talk with that terminal.
1040 CHECK_PROCESS (process);
1041 return MAYBE_LISP_PROCMETH (get_tty_name, (XPROCESS (process)));
1044 DEFUN ("set-process-buffer", Fset_process_buffer, 2, 2, 0, /*
1045 Set buffer associated with PROCESS to BUFFER (a buffer, or nil).
1049 CHECK_PROCESS (process);
1051 CHECK_BUFFER (buffer);
1052 XPROCESS (process)->buffer = buffer;
1056 DEFUN ("process-buffer", Fprocess_buffer, 1, 1, 0, /*
1057 Return the buffer PROCESS is associated with.
1058 Output from PROCESS is inserted in this buffer
1059 unless PROCESS has a filter.
1063 CHECK_PROCESS (process);
1064 return XPROCESS (process)->buffer;
1067 DEFUN ("process-mark", Fprocess_mark, 1, 1, 0, /*
1068 Return the marker for the end of the last output from PROCESS.
1072 CHECK_PROCESS (process);
1073 return XPROCESS (process)->mark;
1077 set_process_filter (Lisp_Object process, Lisp_Object filter, int filter_does_read)
1079 CHECK_PROCESS (process);
1080 if (PROCESS_READABLE_P (XPROCESS (process))) {
1081 if (EQ (filter, Qt))
1082 event_stream_unselect_process (XPROCESS (process));
1084 event_stream_select_process (XPROCESS (process));
1087 XPROCESS (process)->filter = filter;
1088 XPROCESS (process)->filter_does_read = filter_does_read;
1091 DEFUN ("set-process-filter", Fset_process_filter, 2, 2, 0, /*
1092 Give PROCESS the filter function FILTER; nil means no filter.
1093 t means stop accepting output from the process.
1094 When a process has a filter, each time it does output
1095 the entire string of output is passed to the filter.
1096 The filter gets two arguments: the process and the string of output.
1097 If the process has a filter, its buffer is not used for output.
1101 set_process_filter (process, filter, 0);
1105 DEFUN ("process-filter", Fprocess_filter, 1, 1, 0, /*
1106 Return the filter function of PROCESS; nil if none.
1107 See `set-process-filter' for more info on filter functions.
1111 CHECK_PROCESS (process);
1112 return XPROCESS (process)->filter;
1115 DEFUN ("process-send-region", Fprocess_send_region, 3, 4, 0, /*
1116 Send current contents of the region between START and END as input to PROCESS.
1117 PROCESS may be a process or the name of a process, or a buffer or the
1118 name of a buffer, in which case the buffer's process is used. If it
1119 is nil, the current buffer's process is used.
1120 BUFFER specifies the buffer to look in; if nil, the current buffer is used.
1121 If STRING is more than 100 or so characters long, it may be sent in
1122 several chunks. This may happen even for shorter strings. Output
1123 from processes can arrive in between chunks.
1125 (process, start, end, buffer))
1127 /* This function can GC */
1128 Bufpos bstart, bend;
1129 struct buffer *buf = decode_buffer (buffer, 0);
1131 XSETBUFFER (buffer, buf);
1132 process = get_process (process);
1133 get_buffer_range_char (buf, start, end, &bstart, &bend, 0);
1135 send_process (process, buffer, 0, bstart, bend - bstart);
1139 DEFUN ("process-send-string", Fprocess_send_string, 2, 4, 0, /*
1140 Send PROCESS the contents of STRING as input.
1141 PROCESS may be a process or the name of a process, or a buffer or the
1142 name of a buffer, in which case the buffer's process is used. If it
1143 is nil, the current buffer's process is used.
1144 Optional arguments START and END specify part of STRING; see `substring'.
1145 If STRING is more than 100 or so characters long, it may be sent in
1146 several chunks. This may happen even for shorter strings. Output
1147 from processes can arrive in between chunks.
1149 (process, string, start, end))
1151 /* This function can GC */
1152 Bytecount bstart, bend;
1154 process = get_process (process);
1155 CHECK_STRING (string);
1156 get_string_range_byte (string, start, end, &bstart, &bend,
1157 GB_HISTORICAL_STRING_BEHAVIOR);
1159 send_process (process, string, 0, bstart, bend - bstart);
1165 DEFUN ("process-input-coding-system", Fprocess_input_coding_system, 1, 1, 0, /*
1166 Return PROCESS's input coding system.
1170 process = get_process (process);
1171 CHECK_READABLE_PROCESS (process);
1172 return decoding_stream_coding_system (XLSTREAM (XPROCESS (process)->coding_instream) );
1175 DEFUN ("process-output-coding-system", Fprocess_output_coding_system, 1, 1, 0, /*
1176 Return PROCESS's output coding system.
1180 process = get_process (process);
1181 CHECK_LIVE_PROCESS (process);
1182 return encoding_stream_coding_system (XLSTREAM (XPROCESS (process)->coding_outstream));
1185 DEFUN ("process-coding-system", Fprocess_coding_system, 1, 1, 0, /*
1186 Return a pair of coding-system for decoding and encoding of PROCESS.
1190 process = get_process (process);
1191 CHECK_READABLE_PROCESS (process);
1192 return Fcons (decoding_stream_coding_system
1193 (XLSTREAM (XPROCESS (process)->coding_instream)),
1194 encoding_stream_coding_system
1195 (XLSTREAM (XPROCESS (process)->coding_outstream)));
1198 DEFUN ("set-process-input-coding-system", Fset_process_input_coding_system,
1200 Set PROCESS's input coding system to CODESYS.
1204 codesys = Fget_coding_system (codesys);
1205 process = get_process (process);
1206 CHECK_READABLE_PROCESS (process);
1208 set_decoding_stream_coding_system
1209 (XLSTREAM (XPROCESS (process)->coding_instream), codesys);
1213 DEFUN ("set-process-output-coding-system", Fset_process_output_coding_system,
1215 Set PROCESS's output coding system to CODESYS.
1219 codesys = Fget_coding_system (codesys);
1220 process = get_process (process);
1221 CHECK_LIVE_PROCESS (process);
1223 set_encoding_stream_coding_system
1224 (XLSTREAM (XPROCESS (process)->coding_outstream), codesys);
1228 DEFUN ("set-process-coding-system", Fset_process_coding_system,
1230 Set coding-systems of PROCESS to DECODING and ENCODING.
1231 DECODING will be used to decode subprocess output and ENCODING to
1232 encode subprocess input.
1234 (process, decoding, encoding))
1236 if (!NILP (decoding))
1237 Fset_process_input_coding_system (process, decoding);
1239 if (!NILP (encoding))
1240 Fset_process_output_coding_system (process, encoding);
1245 #endif /* FILE_CODING */
1247 /************************************************************************/
1248 /* process status */
1249 /************************************************************************/
1252 exec_sentinel_unwind (Lisp_Object datum)
1254 Lisp_Cons *d = XCONS (datum);
1255 XPROCESS (d->car)->sentinel = d->cdr;
1261 exec_sentinel (Lisp_Object process, Lisp_Object reason)
1263 /* This function can GC */
1264 int speccount = specpdl_depth ();
1265 Lisp_Process *p = XPROCESS (process);
1266 Lisp_Object sentinel = p->sentinel;
1268 if (NILP (sentinel))
1271 /* Some weird FSFmacs crap here with
1272 Vdeactivate_mark and current_buffer->keymap */
1274 /* Zilch the sentinel while it's running, to avoid recursive invocations;
1275 assure that it gets restored no matter how the sentinel exits. */
1277 record_unwind_protect (exec_sentinel_unwind, noseeum_cons (process, sentinel));
1278 /* We used to bind inhibit-quit to t here, but call2_trapping_errors()
1279 does that for us. */
1280 running_asynch_code = 1;
1281 call2_trapping_errors ("Error in process sentinel", sentinel, process, reason);
1282 running_asynch_code = 0;
1283 restore_match_data ();
1284 unbind_to (speccount, Qnil);
1287 DEFUN ("set-process-sentinel", Fset_process_sentinel, 2, 2, 0, /*
1288 Give PROCESS the sentinel SENTINEL; nil for none.
1289 The sentinel is called as a function when the process changes state.
1290 It gets two arguments: the process, and a string describing the change.
1292 (process, sentinel))
1294 CHECK_PROCESS (process);
1295 XPROCESS (process)->sentinel = sentinel;
1299 DEFUN ("process-sentinel", Fprocess_sentinel, 1, 1, 0, /*
1300 Return the sentinel of PROCESS; nil if none.
1301 See `set-process-sentinel' for more info on sentinels.
1305 CHECK_PROCESS (process);
1306 return XPROCESS (process)->sentinel;
1311 signal_name (int signum)
1313 if (signum >= 0 && signum < NSIG)
1314 return (const char *) sys_siglist[signum];
1316 return (const char *) GETTEXT ("unknown signal");
1320 update_process_status (Lisp_Object p,
1321 Lisp_Object status_symbol,
1325 XPROCESS (p)->tick++;
1327 XPROCESS (p)->status_symbol = status_symbol;
1328 XPROCESS (p)->exit_code = exit_code;
1329 XPROCESS (p)->core_dumped = core_dumped;
1332 /* Return a string describing a process status list. */
1335 status_message (Lisp_Process *p)
1337 Lisp_Object symbol = p->status_symbol;
1338 int code = p->exit_code;
1339 int coredump = p->core_dumped;
1340 Lisp_Object string, string2;
1342 if (EQ (symbol, Qsignal) || EQ (symbol, Qstop))
1344 string = build_string (signal_name (code));
1346 string2 = build_translated_string (" (core dumped)\n");
1348 string2 = build_string ("\n");
1349 set_string_char (XSTRING (string), 0,
1350 DOWNCASE (current_buffer,
1351 string_char (XSTRING (string), 0)));
1352 return concat2 (string, string2);
1354 else if (EQ (symbol, Qexit))
1357 return build_translated_string ("finished\n");
1358 string = Fnumber_to_string (make_int (code));
1360 string2 = build_translated_string (" (core dumped)\n");
1362 string2 = build_string ("\n");
1363 return concat2 (build_translated_string ("exited abnormally with code "),
1364 concat2 (string, string2));
1367 return Fcopy_sequence (Fsymbol_name (symbol));
1370 /* Tell status_notify() to check for terminated processes. We do this
1371 because on some systems we sometimes miss SIGCHLD calls. (Not sure
1375 kick_status_notify (void)
1381 /* Report all recent events of a change in process status
1382 (either run the sentinel or output a message).
1383 This is done while Emacs is waiting for keyboard input. */
1386 status_notify (void)
1388 /* This function can GC */
1389 Lisp_Object tail = Qnil;
1390 Lisp_Object symbol = Qnil;
1391 Lisp_Object msg = Qnil;
1392 struct gcpro gcpro1, gcpro2, gcpro3;
1393 /* process_tick is volatile, so we have to remember it now.
1394 Otherwise, we get a race condition if SIGCHLD happens during
1397 (Actually, this is not the case anymore. The code to
1398 update the process structures has been moved out of the
1399 SIGCHLD handler. But for the moment I'm leaving this
1400 stuff in -- it can't hurt.) */
1401 int temp_process_tick;
1403 MAYBE_PROCMETH (reap_exited_processes, ());
1405 temp_process_tick = process_tick;
1407 if (update_tick == temp_process_tick)
1410 /* We need to gcpro tail; if read_process_output calls a filter
1411 which deletes a process and removes the cons to which tail points
1412 from Vprocess_alist, and then causes a GC, tail is an unprotected
1414 GCPRO3 (tail, symbol, msg);
1416 for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail))
1418 Lisp_Object process = XCAR (tail);
1419 Lisp_Process *p = XPROCESS (process);
1420 /* p->tick is also volatile. Same thing as above applies. */
1421 int this_process_tick;
1423 /* #### extra check for terminated processes, in case a SIGCHLD
1424 got missed (this seems to happen sometimes, I'm not sure why).
1427 MAYBE_PROCMETH (update_status_if_terminated, (p));
1429 this_process_tick = p->tick;
1430 if (this_process_tick != p->update_tick)
1432 p->update_tick = this_process_tick;
1434 /* If process is still active, read any output that remains. */
1435 while (!EQ (p->filter, Qt)
1436 && read_process_output (process) > 0)
1439 /* Get the text to use for the message. */
1440 msg = status_message (p);
1442 /* If process is terminated, deactivate it or delete it. */
1443 symbol = p->status_symbol;
1445 if (EQ (symbol, Qsignal)
1446 || EQ (symbol, Qexit))
1448 if (delete_exited_processes)
1449 remove_process (process);
1451 deactivate_process (process);
1454 /* Now output the message suitably. */
1455 if (!NILP (p->sentinel))
1456 exec_sentinel (process, msg);
1457 /* Don't bother with a message in the buffer
1458 when a process becomes runnable. */
1459 else if (!EQ (symbol, Qrun) && !NILP (p->buffer))
1461 Lisp_Object old_read_only = Qnil;
1462 Lisp_Object old = Fcurrent_buffer ();
1464 struct gcpro ngcpro1, ngcpro2;
1466 /* Avoid error if buffer is deleted
1467 (probably that's why the process is dead, too) */
1468 if (!BUFFER_LIVE_P (XBUFFER (p->buffer)))
1471 NGCPRO2 (old, old_read_only);
1472 Fset_buffer (p->buffer);
1473 opoint = BUF_PT (current_buffer);
1474 /* Insert new output into buffer
1475 at the current end-of-output marker,
1476 thus preserving logical ordering of input and output. */
1477 if (XMARKER (p->mark)->buffer)
1478 BUF_SET_PT (current_buffer, marker_position (p->mark));
1480 BUF_SET_PT (current_buffer, BUF_ZV (current_buffer));
1481 if (BUF_PT (current_buffer) <= opoint)
1482 opoint += (string_char_length (XSTRING (msg))
1483 + string_char_length (XSTRING (p->name))
1486 old_read_only = current_buffer->read_only;
1487 current_buffer->read_only = Qnil;
1488 buffer_insert_c_string (current_buffer, "\nProcess ");
1489 Finsert (1, &p->name);
1490 buffer_insert_c_string (current_buffer, " ");
1492 current_buffer->read_only = old_read_only;
1493 Fset_marker (p->mark, make_int (BUF_PT (current_buffer)),
1496 opoint = bufpos_clip_to_bounds(BUF_BEGV (XBUFFER (p->buffer)),
1498 BUF_ZV (XBUFFER (p->buffer)));
1499 BUF_SET_PT (current_buffer, opoint);
1506 /* in case buffers use %s in modeline-format */
1507 MARK_MODELINE_CHANGED;
1510 update_tick = temp_process_tick;
1515 DEFUN ("process-status", Fprocess_status, 1, 1, 0, /*
1516 Return the status of PROCESS.
1517 This is a symbol, one of these:
1519 run -- for a process that is running.
1520 stop -- for a process stopped but continuable.
1521 exit -- for a process that has exited.
1522 signal -- for a process that has got a fatal signal.
1523 open -- for a network stream connection that is open.
1524 closed -- for a network stream connection that is closed.
1525 nil -- if arg is a process name and no such process exists.
1527 PROCESS may be a process, a buffer, the name of a process or buffer, or
1528 nil, indicating the current buffer's process.
1532 Lisp_Object status_symbol;
1534 if (STRINGP (process))
1535 process = Fget_process (process);
1537 process = get_process (process);
1542 status_symbol = XPROCESS (process)->status_symbol;
1543 if (network_connection_p (process))
1545 if (EQ (status_symbol, Qrun))
1546 status_symbol = Qopen;
1547 else if (EQ (status_symbol, Qexit))
1548 status_symbol = Qclosed;
1550 return status_symbol;
1553 DEFUN ("process-exit-status", Fprocess_exit_status, 1, 1, 0, /*
1554 Return the exit status of PROCESS or the signal number that killed it.
1555 If PROCESS has not yet exited or died, return 0.
1559 CHECK_PROCESS (process);
1560 return make_int (XPROCESS (process)->exit_code);
1566 decode_signal (Lisp_Object signal_)
1569 return XINT (signal_);
1574 CHECK_SYMBOL (signal_);
1575 name = string_data (XSYMBOL (signal_)->name);
1577 #define handle_signal(sym) do { \
1578 if (!strcmp ((const char *) name, #sym)) \
1582 handle_signal (SIGINT); /* ANSI */
1583 handle_signal (SIGILL); /* ANSI */
1584 handle_signal (SIGABRT); /* ANSI */
1585 handle_signal (SIGFPE); /* ANSI */
1586 handle_signal (SIGSEGV); /* ANSI */
1587 handle_signal (SIGTERM); /* ANSI */
1590 handle_signal (SIGHUP); /* POSIX */
1593 handle_signal (SIGQUIT); /* POSIX */
1596 handle_signal (SIGTRAP); /* POSIX */
1599 handle_signal (SIGKILL); /* POSIX */
1602 handle_signal (SIGUSR1); /* POSIX */
1605 handle_signal (SIGUSR2); /* POSIX */
1608 handle_signal (SIGPIPE); /* POSIX */
1611 handle_signal (SIGALRM); /* POSIX */
1614 handle_signal (SIGCHLD); /* POSIX */
1617 handle_signal (SIGCONT); /* POSIX */
1620 handle_signal (SIGSTOP); /* POSIX */
1623 handle_signal (SIGTSTP); /* POSIX */
1626 handle_signal (SIGTTIN); /* POSIX */
1629 handle_signal (SIGTTOU); /* POSIX */
1633 handle_signal (SIGBUS); /* XPG5 */
1636 handle_signal (SIGPOLL); /* XPG5 */
1639 handle_signal (SIGPROF); /* XPG5 */
1642 handle_signal (SIGSYS); /* XPG5 */
1645 handle_signal (SIGURG); /* XPG5 */
1648 handle_signal (SIGXCPU); /* XPG5 */
1651 handle_signal (SIGXFSZ); /* XPG5 */
1654 handle_signal (SIGVTALRM); /* XPG5 */
1658 handle_signal (SIGIO); /* BSD 4.2 */
1661 handle_signal (SIGWINCH); /* BSD 4.3 */
1665 handle_signal (SIGEMT);
1668 handle_signal (SIGINFO);
1671 handle_signal (SIGHWE);
1674 handle_signal (SIGPRE);
1677 handle_signal (SIGUME);
1680 handle_signal (SIGDLK);
1683 handle_signal (SIGCPULIM);
1686 handle_signal (SIGIOT);
1689 handle_signal (SIGLOST);
1692 handle_signal (SIGSTKFLT);
1695 handle_signal (SIGUNUSED);
1698 handle_signal (SIGDANGER); /* AIX */
1701 handle_signal (SIGMSG);
1704 handle_signal (SIGSOUND);
1707 handle_signal (SIGRETRACT);
1710 handle_signal (SIGGRANT);
1713 handle_signal (SIGPWR);
1716 #undef handle_signal
1718 error ("Undefined signal name %s", name);
1719 return 0; /* Unreached */
1723 /* Send signal number SIGNO to PROCESS.
1724 CURRENT-GROUP non-nil means send signal to the current
1725 foreground process group of the process's controlling terminal rather
1726 than to the process's own process group.
1727 This is used for various commands in shell mode.
1728 If NOMSG is zero, insert signal-announcements into process's buffers
1731 If we can, we try to signal PROCESS by sending control characters
1732 down the pty. This allows us to signal inferiors who have changed
1733 their uid, for which kill() would return an EPERM error, or to
1734 processes running on another computer through a remote login. */
1737 process_send_signal (Lisp_Object process, int signo,
1738 int current_group, int nomsg)
1740 /* This function can GC */
1741 process = get_process (process);
1743 if (network_connection_p (process))
1744 error ("Network connection %s is not a subprocess",
1745 XSTRING_DATA (XPROCESS(process)->name));
1746 CHECK_LIVE_PROCESS (process);
1748 MAYBE_PROCMETH (kill_child_process, (process, signo, current_group, nomsg));
1751 DEFUN ("process-send-signal", Fprocess_send_signal, 1, 3, 0, /*
1752 Send signal SIGNAL to process PROCESS.
1753 SIGNAL may be an integer, or a symbol naming a signal, like `SIGSEGV'.
1754 PROCESS may be a process, a buffer, the name of a process or buffer, or
1755 nil, indicating the current buffer's process.
1756 Third arg CURRENT-GROUP non-nil means send signal to the current
1757 foreground process group of the process's controlling terminal rather
1758 than to the process's own process group.
1759 If the process is a shell that supports job control, this means
1760 send the signal to the current subjob rather than the shell.
1762 (signal_, process, current_group))
1764 /* This function can GC */
1765 process_send_signal (process, decode_signal (signal_),
1766 !NILP (current_group), 0);
1770 DEFUN ("interrupt-process", Finterrupt_process, 0, 2, 0, /*
1771 Interrupt process PROCESS.
1772 See function `process-send-signal' for more details on usage.
1774 (process, current_group))
1776 /* This function can GC */
1777 process_send_signal (process, SIGINT, !NILP (current_group), 0);
1781 DEFUN ("kill-process", Fkill_process, 0, 2, 0, /*
1782 Kill process PROCESS.
1783 See function `process-send-signal' for more details on usage.
1785 (process, current_group))
1787 /* This function can GC */
1789 process_send_signal (process, SIGKILL, !NILP (current_group), 0);
1791 error ("kill-process: Not supported on this system");
1796 DEFUN ("quit-process", Fquit_process, 0, 2, 0, /*
1797 Send QUIT signal to process PROCESS.
1798 See function `process-send-signal' for more details on usage.
1800 (process, current_group))
1802 /* This function can GC */
1804 process_send_signal (process, SIGQUIT, !NILP (current_group), 0);
1806 error ("quit-process: Not supported on this system");
1811 DEFUN ("stop-process", Fstop_process, 0, 2, 0, /*
1812 Stop process PROCESS.
1813 See function `process-send-signal' for more details on usage.
1815 (process, current_group))
1817 /* This function can GC */
1819 process_send_signal (process, SIGTSTP, !NILP (current_group), 0);
1821 error ("stop-process: Not supported on this system");
1826 DEFUN ("continue-process", Fcontinue_process, 0, 2, 0, /*
1827 Continue process PROCESS.
1828 See function `process-send-signal' for more details on usage.
1830 (process, current_group))
1832 /* This function can GC */
1834 process_send_signal (process, SIGCONT, !NILP (current_group), 0);
1836 error ("continue-process: Not supported on this system");
1841 DEFUN ("signal-process", Fsignal_process, 2, 2,
1842 "nProcess number: \nnSignal code: ", /*
1843 Send the process with process id PID the signal with code SIGNAL.
1844 PID must be an integer. The process need not be a child of this Emacs.
1845 SIGNAL may be an integer, or a symbol naming a signal, like `SIGSEGV'.
1851 return make_int (PROCMETH_OR_GIVEN (kill_process_by_pid,
1852 (XINT (pid), decode_signal (signal_)),
1856 DEFUN ("process-send-eof", Fprocess_send_eof, 0, 1, 0, /*
1857 Make PROCESS see end-of-file in its input.
1858 PROCESS may be a process, a buffer, the name of a process or buffer, or
1859 nil, indicating the current buffer's process.
1860 If PROCESS is a network connection, or is a process communicating
1861 through a pipe (as opposed to a pty), then you cannot send any more
1862 text to PROCESS after you call this function.
1866 /* This function can GC */
1867 process = get_process (process);
1869 /* Make sure the process is really alive. */
1870 if (! EQ (XPROCESS (process)->status_symbol, Qrun))
1871 error ("Process %s not running", XSTRING_DATA (XPROCESS (process)->name));
1873 if (!MAYBE_INT_PROCMETH (process_send_eof, (process)))
1875 if (!NILP (DATA_OUTSTREAM (XPROCESS (process))))
1877 Lstream_close (XLSTREAM (DATA_OUTSTREAM (XPROCESS (process))));
1878 event_stream_delete_stream_pair (Qnil, XPROCESS (process)->pipe_outstream);
1879 XPROCESS (process)->pipe_outstream = Qnil;
1881 XPROCESS (process)->coding_outstream = Qnil;
1890 /************************************************************************/
1891 /* deleting a process */
1892 /************************************************************************/
1895 deactivate_process (Lisp_Object process)
1897 Lisp_Process *p = XPROCESS (process);
1900 /* It's possible that we got as far in the process-creation
1901 process as creating the descriptors but didn't get so
1902 far as selecting the process for input. In this
1903 case, p->pid is nil: p->pid is set at the same time that
1904 the process is selected for input. */
1905 /* #### The comment does not look correct. event_stream_unselect_process
1906 is guarded by process->selected, so this is not a problem. - kkm*/
1907 /* Must call this before setting the streams to nil */
1908 event_stream_unselect_process (p);
1910 if (!NILP (DATA_OUTSTREAM (p)))
1911 Lstream_close (XLSTREAM (DATA_OUTSTREAM (p)));
1912 if (!NILP (DATA_INSTREAM (p)))
1913 Lstream_close (XLSTREAM (DATA_INSTREAM (p)));
1915 /* Provide minimal implementation for deactivate_process
1916 if there's no process-specific one */
1917 if (HAS_PROCMETH_P (deactivate_process))
1918 usid = PROCMETH (deactivate_process, (p));
1920 usid = event_stream_delete_stream_pair (p->pipe_instream,
1923 if (usid != USID_DONTHASH)
1924 remhash ((const void*)usid, usid_to_process);
1926 p->pipe_instream = Qnil;
1927 p->pipe_outstream = Qnil;
1929 p->coding_instream = Qnil;
1930 p->coding_outstream = Qnil;
1935 remove_process (Lisp_Object process)
1937 Vprocess_list = delq_no_quit (process, Vprocess_list);
1938 Fset_marker (XPROCESS (process)->mark, Qnil, Qnil);
1940 deactivate_process (process);
1943 DEFUN ("delete-process", Fdelete_process, 1, 1, 0, /*
1944 Delete PROCESS: kill it and forget about it immediately.
1945 PROCESS may be a process or the name of one, or a buffer name.
1949 /* This function can GC */
1951 process = get_process (process);
1952 p = XPROCESS (process);
1953 if (network_connection_p (process))
1955 p->status_symbol = Qexit;
1961 else if (PROCESS_LIVE_P (p))
1963 Fkill_process (process, Qnil);
1964 /* Do this now, since remove_process will make sigchld_handler do nothing. */
1965 p->status_symbol = Qsignal;
1966 p->exit_code = SIGKILL;
1972 remove_process (process);
1976 /* Kill all processes associated with `buffer'.
1977 If `buffer' is nil, kill all processes */
1980 kill_buffer_processes (Lisp_Object buffer)
1982 LIST_LOOP_2 (process, Vprocess_list)
1983 if ((NILP (buffer) || EQ (XPROCESS (process)->buffer, buffer)))
1985 if (network_connection_p (process))
1986 Fdelete_process (process);
1987 else if (PROCESS_LIVE_P (XPROCESS (process)))
1988 process_send_signal (process, SIGHUP, 0, 1);
1992 DEFUN ("process-kill-without-query", Fprocess_kill_without_query, 1, 2, 0, /*
1993 Say no query needed if PROCESS is running when Emacs is exited.
1994 Optional second argument if non-nil says to require a query.
1995 Value is t if a query was formerly required.
1997 (process, require_query_p))
2001 CHECK_PROCESS (process);
2002 tem = XPROCESS (process)->kill_without_query;
2003 XPROCESS (process)->kill_without_query = NILP (require_query_p);
2005 return tem ? Qnil : Qt;
2008 DEFUN ("process-kill-without-query-p", Fprocess_kill_without_query_p, 1, 1, 0, /*
2009 Return t if PROCESS will be killed without query when emacs is exited.
2013 CHECK_PROCESS (process);
2014 return XPROCESS (process)->kill_without_query ? Qt : Qnil;
2018 /* This is not named init_process in order to avoid a conflict with NS 3.3 */
2020 init_xemacs_process (void)
2022 MAYBE_PROCMETH (init_process, ());
2024 Vprocess_list = Qnil;
2026 if (usid_to_process)
2027 clrhash (usid_to_process);
2029 usid_to_process = make_hash_table (32);
2034 xxDEFUN ("process-connection", Fprocess_connection, 0, 1, 0, /*
2035 Return the connection type of `PROCESS'. This can be nil (pipe),
2036 t or pty (pty) or stream (socket connection).
2040 return XPROCESS (process)->type;
2046 syms_of_process (void)
2048 INIT_LRECORD_IMPLEMENTATION (process);
2050 defsymbol (&Qprocessp, "processp");
2051 defsymbol (&Qprocess_live_p, "process-live-p");
2053 /* see comment at Fprocess_readable_p */
2054 defsymbol (&Qprocess_readable_p, "process-readable-p");
2056 defsymbol (&Qrun, "run");
2057 defsymbol (&Qstop, "stop");
2058 defsymbol (&Qopen, "open");
2059 defsymbol (&Qclosed, "closed");
2061 defsymbol (&Qtcp, "tcp");
2062 defsymbol (&Qudp, "udp");
2064 #ifdef HAVE_MULTICAST
2065 defsymbol(&Qmulticast, "multicast"); /* Used for occasional warnings */
2068 DEFSUBR (Fprocessp);
2069 DEFSUBR (Fprocess_live_p);
2071 /* see comment at Fprocess_readable_p */
2072 DEFSUBR (Fprocess_readable_p);
2074 DEFSUBR (Fget_process);
2075 DEFSUBR (Fget_buffer_process);
2076 DEFSUBR (Fdelete_process);
2077 DEFSUBR (Fprocess_status);
2078 DEFSUBR (Fprocess_exit_status);
2079 DEFSUBR (Fprocess_id);
2080 DEFSUBR (Fprocess_name);
2081 DEFSUBR (Fprocess_tty_name);
2082 DEFSUBR (Fprocess_command);
2083 DEFSUBR (Fset_process_buffer);
2084 DEFSUBR (Fprocess_buffer);
2085 DEFSUBR (Fprocess_mark);
2086 DEFSUBR (Fset_process_filter);
2087 DEFSUBR (Fprocess_filter);
2088 DEFSUBR (Fset_process_window_size);
2089 DEFSUBR (Fset_process_sentinel);
2090 DEFSUBR (Fprocess_sentinel);
2091 DEFSUBR (Fprocess_kill_without_query);
2092 DEFSUBR (Fprocess_kill_without_query_p);
2093 DEFSUBR (Fprocess_list);
2094 DEFSUBR (Fstart_process_internal);
2096 DEFSUBR (Fopen_network_stream_internal);
2097 #ifdef HAVE_MULTICAST
2098 DEFSUBR (Fopen_multicast_group_internal);
2099 #endif /* HAVE_MULTICAST */
2100 #endif /* HAVE_SOCKETS */
2101 DEFSUBR (Fprocess_send_region);
2102 DEFSUBR (Fprocess_send_string);
2103 DEFSUBR (Fprocess_send_signal);
2104 DEFSUBR (Finterrupt_process);
2105 DEFSUBR (Fkill_process);
2106 DEFSUBR (Fquit_process);
2107 DEFSUBR (Fstop_process);
2108 DEFSUBR (Fcontinue_process);
2109 DEFSUBR (Fprocess_send_eof);
2110 DEFSUBR (Fsignal_process);
2111 /* DEFSUBR (Fprocess_connection); */
2113 DEFSUBR (Fprocess_input_coding_system);
2114 DEFSUBR (Fprocess_output_coding_system);
2115 DEFSUBR (Fset_process_input_coding_system);
2116 DEFSUBR (Fset_process_output_coding_system);
2117 DEFSUBR (Fprocess_coding_system);
2118 DEFSUBR (Fset_process_coding_system);
2119 #endif /* FILE_CODING */
2123 vars_of_process (void)
2125 Fprovide (intern ("subprocesses"));
2127 Fprovide (intern ("network-streams"));
2128 #ifdef HAVE_MULTICAST
2129 Fprovide (intern ("multicast"));
2130 #endif /* HAVE_MULTICAST */
2131 #endif /* HAVE_SOCKETS */
2132 staticpro (&Vprocess_list);
2134 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes /*
2135 *Non-nil means delete processes immediately when they exit.
2136 nil means don't delete them until `list-processes' is run.
2139 delete_exited_processes = 1;
2141 DEFVAR_CONST_LISP ("null-device", &Vnull_device /*
2142 Name of the null device, which differs from system to system.
2143 The null device is a filename that acts as a sink for arbitrary amounts of
2144 data, which is discarded, or as a source for a zero-length file.
2145 It is available on all the systems that we currently support, but with
2146 different names (typically either `/dev/null' or `nul').
2148 Note that there is also a /dev/zero on most modern Unix versions (including
2149 Cygwin), which acts like /dev/null when used as a sink, but as a source
2150 it sends a non-ending stream of zero bytes. It's used most often along
2151 with memory-mapping. We don't provide a Lisp variable for this because
2152 the operations needing this are lower level than what ELisp programs
2153 typically do, and in any case no equivalent exists under native MS Windows.
2155 Vnull_device = build_string (NULL_DEVICE);
2157 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type /*
2158 Control type of device used to communicate with subprocesses.
2159 Values are nil to use a pipe, or t or `pty' to use a pty.
2160 The value has no effect if the system has no ptys or if all ptys are busy:
2161 then a pipe is used in any case.
2162 The value takes effect when `start-process' is called.
2164 Vprocess_connection_type = Qt;
2166 DEFVAR_BOOL ("windowed-process-io", &windowed_process_io /*
2167 Enables input/output on standard handles of a windowed process.
2168 When this variable is nil (the default), XEmacs does not attempt to read
2169 standard output handle of a windowed process. Instead, the process is
2170 immediately marked as exited immediately upon successful launching. This is
2171 done because normal windowed processes do not use standard I/O, as they are
2172 not connected to any console.
2174 When launching a specially crafted windowed process, which expects to be
2175 launched by XEmacs, or by other program which pipes its standard input and
2176 output, this variable must be set to non-nil, in which case XEmacs will
2177 treat this process just like a console process.
2179 NOTE: You should never set this variable, only bind it.
2181 Only Windows processes can be "windowed" or "console". This variable has no
2182 effect on UNIX processes, because all UNIX processes are "console".
2184 windowed_process_io = 0;
2186 #ifdef PROCESS_IO_BLOCKING
2187 DEFVAR_LISP ("network-stream-blocking-port-list", &network_stream_blocking_port_list /*
2188 List of port numbers or port names to set a blocking I/O mode with connection.
2189 Nil value means to set a default(non-blocking) I/O mode.
2190 The value takes effect when `open-network-stream-internal' is called.
2192 network_stream_blocking_port_list = Qnil;
2193 #endif /* PROCESS_IO_BLOCKING */
2196 #endif /* not NO_SUBPROCESSES */