Mercurial > hg > xemacs-beta
diff src/process.c @ 428:3ecd8885ac67 r21-2-22
Import from CVS: tag r21-2-22
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:28:15 +0200 |
parents | |
children | 8de8e3f6228a |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/process.c Mon Aug 13 11:28:15 2007 +0200 @@ -0,0 +1,2099 @@ +/* Asynchronous subprocess control for XEmacs. + Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993, 1994, 1995 + Free Software Foundation, Inc. + Copyright (C) 1995 Sun Microsystems, Inc. + Copyright (C) 1995, 1996 Ben Wing. + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* This file has been Mule-ized except for `start-process-internal', + `open-network-stream-internal' and `open-multicast-group-internal'. */ + +/* This file has been split into process.c and process-unix.c by + Kirill M. Katsnelson <kkm@kis.ru>, so please bash him and not + the original author(s) */ + +#include <config.h> + +#if !defined (NO_SUBPROCESSES) + +/* The entire file is within this conditional */ + +#include "lisp.h" + +#include "buffer.h" +#include "commands.h" +#include "events.h" +#include "frame.h" +#include "hash.h" +#include "insdel.h" +#include "lstream.h" +#include "opaque.h" +#include "process.h" +#include "procimpl.h" +#include "window.h" +#ifdef FILE_CODING +#include "file-coding.h" +#endif + +#include "sysfile.h" +#include "sysproc.h" +#include "systime.h" +#include "syssignal.h" /* Always include before systty.h */ +#include "systty.h" +#include "syswait.h" + +Lisp_Object Qprocessp; + +/* Process methods */ +struct process_methods the_process_methods; + +/* a process object is a network connection when its pid field a cons + (name of name of port we are connected to . foreign host name) */ + +/* Valid values of process->status_symbol */ +Lisp_Object Qrun, Qstop; +/* Qrun => Qopen, Qexit => Qclosed for "network connection" processes */ +Lisp_Object Qopen, Qclosed; +/* Protocol families */ +Lisp_Object Qtcp, Qudp; + +#ifdef HAVE_MULTICAST +Lisp_Object Qmulticast; /* Will be used for occasional warnings */ +#endif + +/* t means use pty, nil means use a pipe, + maybe other values to come. */ +Lisp_Object Vprocess_connection_type; + +/* Read comments to DEFVAR of this */ +int windowed_process_io; + +#ifdef PROCESS_IO_BLOCKING +/* List of port numbers or port names to set a blocking I/O mode. + Nil means set a non-blocking I/O mode [default]. */ +Lisp_Object network_stream_blocking_port_list; +#endif /* PROCESS_IO_BLOCKING */ + +/* Number of events of change of status of a process. */ +volatile int process_tick; + +/* Number of events for which the user or sentinel has been notified. */ +static int update_tick; + +/* Nonzero means delete a process right away if it exits. */ +int delete_exited_processes; + +/* Hash table which maps USIDs as returned by create_stream_pair_cb to + process objects. Processes are not GC-protected through this! */ +struct hash_table *usid_to_process; + +/* List of process objects. */ +Lisp_Object Vprocess_list; + +extern Lisp_Object Vlisp_EXEC_SUFFIXES; + + + +static Lisp_Object +mark_process (Lisp_Object obj) +{ + struct Lisp_Process *proc = XPROCESS (obj); + MAYBE_PROCMETH (mark_process_data, (proc)); + mark_object (proc->name); + mark_object (proc->command); + mark_object (proc->filter); + mark_object (proc->sentinel); + mark_object (proc->buffer); + mark_object (proc->mark); + mark_object (proc->pid); + mark_object (proc->pipe_instream); + mark_object (proc->pipe_outstream); +#ifdef FILE_CODING + mark_object (proc->coding_instream); + mark_object (proc->coding_outstream); +#endif + return proc->status_symbol; +} + +static void +print_process (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) +{ + struct Lisp_Process *proc = XPROCESS (obj); + + if (print_readably) + error ("printing unreadable object #<process %s>", + XSTRING_DATA (proc->name)); + + if (!escapeflag) + { + print_internal (proc->name, printcharfun, 0); + } + else + { + int netp = network_connection_p (obj); + write_c_string ((netp ? GETTEXT ("#<network connection ") : + GETTEXT ("#<process ")), printcharfun); + print_internal (proc->name, printcharfun, 1); + write_c_string ((netp ? " " : " pid "), printcharfun); + print_internal (proc->pid, printcharfun, 1); + write_c_string (" state:", printcharfun); + print_internal (proc->status_symbol, printcharfun, 1); + MAYBE_PROCMETH (print_process_data, (proc, printcharfun)); + write_c_string (">", printcharfun); + } +} + +#ifdef HAVE_WINDOW_SYSTEM +extern void debug_process_finalization (struct Lisp_Process *p); +#endif /* HAVE_WINDOW_SYSTEM */ + +static void +finalize_process (void *header, int for_disksave) +{ + /* #### this probably needs to be tied into the tty event loop */ + /* #### when there is one */ + struct Lisp_Process *p = (struct Lisp_Process *) header; +#ifdef HAVE_WINDOW_SYSTEM + if (!for_disksave) + { + debug_process_finalization (p); + } +#endif /* HAVE_WINDOW_SYSTEM */ + + if (p->process_data) + { + MAYBE_PROCMETH (finalize_process_data, (p, for_disksave)); + if (!for_disksave) + xfree (p->process_data); + } +} + +DEFINE_LRECORD_IMPLEMENTATION ("process", process, + mark_process, print_process, finalize_process, + 0, 0, 0, struct Lisp_Process); + +/************************************************************************/ +/* basic process accessors */ +/************************************************************************/ + +/* Under FILE_CODING, this function returns low-level streams, connected + directly to the child process, rather than en/decoding FILE_CODING + streams */ +void +get_process_streams (struct Lisp_Process *p, + Lisp_Object *instr, Lisp_Object *outstr) +{ + assert (p); + assert (NILP (p->pipe_instream) || LSTREAMP(p->pipe_instream)); + assert (NILP (p->pipe_outstream) || LSTREAMP(p->pipe_outstream)); + *instr = p->pipe_instream; + *outstr = p->pipe_outstream; +} + +struct Lisp_Process * +get_process_from_usid (USID usid) +{ + CONST void *vval; + + assert (usid != USID_ERROR && usid != USID_DONTHASH); + + if (gethash ((CONST void*)usid, usid_to_process, &vval)) + { + Lisp_Object proc; + CVOID_TO_LISP (proc, vval); + return XPROCESS (proc); + } + else + return 0; +} + +int +get_process_selected_p (struct Lisp_Process *p) +{ + return p->selected; +} + +void +set_process_selected_p (struct Lisp_Process *p, int selected_p) +{ + p->selected = !!selected_p; +} + +int +connected_via_filedesc_p (struct Lisp_Process *p) +{ + return MAYBE_INT_PROCMETH (tooltalk_connection_p, (p)); +} + +#ifdef HAVE_SOCKETS +int +network_connection_p (Lisp_Object process) +{ + return CONSP (XPROCESS (process)->pid); +} +#endif + +DEFUN ("processp", Fprocessp, 1, 1, 0, /* +Return t if OBJECT is a process. +*/ + (obj)) +{ + return PROCESSP (obj) ? Qt : Qnil; +} + +DEFUN ("process-list", Fprocess_list, 0, 0, 0, /* +Return a list of all processes. +*/ + ()) +{ + return Fcopy_sequence (Vprocess_list); +} + +DEFUN ("get-process", Fget_process, 1, 1, 0, /* +Return the process named NAME, or nil if there is none. +*/ + (name)) +{ + Lisp_Object tail; + + if (PROCESSP (name)) + return name; + + if (!gc_in_progress) + /* this only gets called during GC when emacs is going away as a result + of a signal or crash. */ + CHECK_STRING (name); + + for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail)) + { + Lisp_Object proc = XCAR (tail); + QUIT; + if (internal_equal (name, XPROCESS (proc)->name, 0)) + return XCAR (tail); + } + return Qnil; +} + +DEFUN ("get-buffer-process", Fget_buffer_process, 1, 1, 0, /* +Return the (or, a) process associated with BUFFER. +BUFFER may be a buffer or the name of one. +*/ + (name)) +{ + Lisp_Object buf, tail, proc; + + if (NILP (name)) return Qnil; + buf = Fget_buffer (name); + if (NILP (buf)) return Qnil; + + for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail)) + { + /* jwz: do not quit here - it isn't necessary, as there is no way for + Vprocess_list to get circular or overwhelmingly long, and this + function is called from layout_mode_element under redisplay. */ + /* QUIT; */ + proc = XCAR (tail); + if (PROCESSP (proc) && EQ (XPROCESS (proc)->buffer, buf)) + return proc; + } + return Qnil; +} + +/* This is how commands for the user decode process arguments. It + accepts a process, a process name, a buffer, a buffer name, or nil. + Buffers denote the first process in the buffer, and nil denotes the + current buffer. */ + +static Lisp_Object +get_process (Lisp_Object name) +{ + Lisp_Object proc, obj; + +#ifdef I18N3 + /* #### Look more closely into translating process names. */ +#endif + + /* This may be called during a GC from process_send_signal() from + kill_buffer_processes() if emacs decides to abort(). */ + if (PROCESSP (name)) + return name; + + if (STRINGP (name)) + { + obj = Fget_process (name); + if (NILP (obj)) + obj = Fget_buffer (name); + if (NILP (obj)) + error ("Process %s does not exist", XSTRING_DATA (name)); + } + else if (NILP (name)) + obj = Fcurrent_buffer (); + else + obj = name; + + /* Now obj should be either a buffer object or a process object. + */ + if (BUFFERP (obj)) + { + proc = Fget_buffer_process (obj); + if (NILP (proc)) + error ("Buffer %s has no process", XSTRING_DATA (XBUFFER(obj)->name)); + } + else + { + /* #### This was commented out. Although, simple + (kill-process 7 "qqq") resulted in a fatal error. - kkm */ + CHECK_PROCESS (obj); + proc = obj; + } + return proc; +} + +DEFUN ("process-id", Fprocess_id, 1, 1, 0, /* +Return the process id of PROCESS. +This is the pid of the Unix process which PROCESS uses or talks to. +For a network connection, this value is a cons of + (foreign-network-port . foreign-host-name). +*/ + (proc)) +{ + Lisp_Object pid; + CHECK_PROCESS (proc); + + pid = XPROCESS (proc)->pid; + if (network_connection_p (proc)) + /* return Qnil; */ + return Fcons (Fcar (pid), Fcdr (pid)); + else + return pid; +} + +DEFUN ("process-name", Fprocess_name, 1, 1, 0, /* +Return the name of PROCESS, as a string. +This is the name of the program invoked in PROCESS, +possibly modified to make it unique among process names. +*/ + (proc)) +{ + CHECK_PROCESS (proc); + return XPROCESS (proc)->name; +} + +DEFUN ("process-command", Fprocess_command, 1, 1, 0, /* +Return the command that was executed to start PROCESS. +This is a list of strings, the first string being the program executed +and the rest of the strings being the arguments given to it. +*/ + (proc)) +{ + CHECK_PROCESS (proc); + return XPROCESS (proc)->command; +} + + +/************************************************************************/ +/* creating a process */ +/************************************************************************/ + +Lisp_Object +make_process_internal (Lisp_Object name) +{ + Lisp_Object val, name1; + int i; + struct Lisp_Process *p = + alloc_lcrecord_type (struct Lisp_Process, &lrecord_process); + + /* If name is already in use, modify it until it is unused. */ + name1 = name; + for (i = 1; ; i++) + { + char suffix[10]; + Lisp_Object tem = Fget_process (name1); + if (NILP (tem)) + break; + sprintf (suffix, "<%d>", i); + name1 = concat2 (name, build_string (suffix)); + } + name = name1; + p->name = name; + + p->command = Qnil; + p->filter = Qnil; + p->sentinel = Qnil; + p->buffer = Qnil; + p->mark = Fmake_marker (); + p->pid = Qnil; + p->status_symbol = Qrun; + p->exit_code = 0; + p->core_dumped = 0; + p->filter_does_read = 0; + p->kill_without_query = 0; + p->selected = 0; + p->tick = 0; + p->update_tick = 0; + p->pipe_instream = Qnil; + p->pipe_outstream = Qnil; +#ifdef FILE_CODING + p->coding_instream = Qnil; + p->coding_outstream = Qnil; +#endif + + p->process_data = 0; + MAYBE_PROCMETH (alloc_process_data, (p)); + + XSETPROCESS (val, p); + + Vprocess_list = Fcons (val, Vprocess_list); + return val; +} + +void +init_process_io_handles (struct Lisp_Process *p, void* in, void* out, int flags) +{ + USID usid = event_stream_create_stream_pair (in, out, + &p->pipe_instream, &p->pipe_outstream, + flags); + + if (usid == USID_ERROR) + report_file_error ("Setting up communication with subprocess", Qnil); + + if (usid != USID_DONTHASH) + { + Lisp_Object proc = Qnil; + XSETPROCESS (proc, p); + puthash ((CONST void*)usid, LISP_TO_VOID (proc), usid_to_process); + } + + MAYBE_PROCMETH (init_process_io_handles, (p, in, out, flags)); + +#ifdef FILE_CODING + p->coding_instream = make_decoding_input_stream + (XLSTREAM (p->pipe_instream), + Fget_coding_system (Vcoding_system_for_read)); + Lstream_set_character_mode (XLSTREAM (p->coding_instream)); + p->coding_outstream = make_encoding_output_stream + (XLSTREAM (p->pipe_outstream), + Fget_coding_system (Vcoding_system_for_write)); + /* CODE_CNTL (&out_state[outchannel]) |= CC_END; !!#### + What's going on here? */ +#endif /* FILE_CODING */ +} + +static void +create_process (Lisp_Object process, Lisp_Object *argv, int nargv, + Lisp_Object program, Lisp_Object cur_dir) +{ + struct Lisp_Process *p = XPROCESS (process); + int pid; + + /* *_create_process may change status_symbol, if the process + is a kind of "fire-and-forget" (no I/O, unwaitable) */ + p->status_symbol = Qrun; + p->exit_code = 0; + + pid = PROCMETH (create_process, (p, argv, nargv, program, cur_dir)); + + p->pid = make_int (pid); + if (!NILP(p->pipe_instream)) + event_stream_select_process (p); +} + +/* This function is the unwind_protect form for Fstart_process_internal. If + PROC doesn't have its pid set, then we know someone has signalled + an error and the process wasn't started successfully, so we should + remove it from the process list. */ +static void remove_process (Lisp_Object proc); +static Lisp_Object +start_process_unwind (Lisp_Object proc) +{ + /* Was PROC started successfully? */ + if (EQ (XPROCESS (proc)->pid, Qnil)) + remove_process (proc); + return Qnil; +} + +DEFUN ("start-process-internal", Fstart_process_internal, 3, MANY, 0, /* +Start a program in a subprocess. Return the process object for it. +Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS +NAME is name for process. It is modified if necessary to make it unique. +BUFFER is the buffer or (buffer-name) to associate with the process. + Process output goes at end of that buffer, unless you specify + an output stream or filter function to handle the output. + BUFFER may be also nil, meaning that this process is not associated + with any buffer +Third arg is program file name. It is searched for as in the shell. +Remaining arguments are strings to give program as arguments. +INCODE and OUTCODE specify the coding-system objects used in input/output + from/to the process. +*/ + (int nargs, Lisp_Object *args)) +{ + /* This function can call lisp */ + /* !!#### This function has not been Mule-ized */ + Lisp_Object buffer, name, program, proc, current_dir; + Lisp_Object tem; + int speccount = specpdl_depth (); + struct gcpro gcpro1, gcpro2, gcpro3; + + name = args[0]; + buffer = args[1]; + program = args[2]; + current_dir = Qnil; + + /* Protect against various file handlers doing GCs below. */ + GCPRO3 (buffer, program, current_dir); + + if (!NILP (buffer)) + buffer = Fget_buffer_create (buffer); + + CHECK_STRING (name); + CHECK_STRING (program); + + /* Make sure that the child will be able to chdir to the current + buffer's current directory, or its unhandled equivalent. We + can't just have the child check for an error when it does the + chdir, since it's in a vfork. + + Note: these assignments and calls are like this in order to insure + "caller protects args" GC semantics. */ + current_dir = current_buffer->directory; + current_dir = Funhandled_file_name_directory (current_dir); + current_dir = expand_and_dir_to_file (current_dir, Qnil); + +#if 0 /* This loser breaks ange-ftp */ + /* dmoore - if you re-enable this code, you have to gcprotect + current_buffer through the above calls. */ + if (NILP (Ffile_accessible_directory_p (current_dir))) + report_file_error ("Setting current directory", + list1 (current_buffer->directory)); +#endif /* 0 */ + + /* If program file name is not absolute, search our path for it */ + if (!IS_DIRECTORY_SEP (XSTRING_BYTE (program, 0)) + && !(XSTRING_LENGTH (program) > 1 + && IS_DEVICE_SEP (XSTRING_BYTE (program, 1)))) + { + struct gcpro ngcpro1; + + tem = Qnil; + NGCPRO1 (tem); + locate_file (Vexec_path, program, Vlisp_EXEC_SUFFIXES, &tem, X_OK); + if (NILP (tem)) + report_file_error ("Searching for program", list1 (program)); + program = Fexpand_file_name (tem, Qnil); + NUNGCPRO; + } + else + { + if (!NILP (Ffile_directory_p (program))) + error ("Specified program for new process is a directory"); + } + + proc = make_process_internal (name); + + XPROCESS (proc)->buffer = buffer; + XPROCESS (proc)->command = Flist (nargs - 2, + args + 2); + + /* Make the process marker point into the process buffer (if any). */ + if (!NILP (buffer)) + Fset_marker (XPROCESS (proc)->mark, + make_int (BUF_ZV (XBUFFER (buffer))), buffer); + + /* If an error occurs and we can't start the process, we want to + remove it from the process list. This means that each error + check in create_process doesn't need to call remove_process + itself; it's all taken care of here. */ + record_unwind_protect (start_process_unwind, proc); + + create_process (proc, args + 3, nargs - 3, program, current_dir); + + UNGCPRO; + return unbind_to (speccount, proc); +} + + +#ifdef HAVE_SOCKETS + + +/* #### The network support is fairly synthetical. What we actually + need is a single function, which supports all datagram, stream and + packet stream connections, arbitrary protocol families should they + be supported by the target system, multicast groups, in both data + and control rooted/nonrooted flavors, service quality etc whatever + is supported by the underlying network. + + It must accept a property list describing the connection. The current + functions must then go to lisp and provide a suitable list for the + generalized connection function. + + Both UNIX and Win32 support BSD sockets, and there are many extensions + available (Sockets 2 spec). + + A todo is define a consistent set of properties abstracting a + network connection. -kkm +*/ + + +/* open a TCP network connection to a given HOST/SERVICE. Treated + exactly like a normal process when reading and writing. Only + differences are in status display and process deletion. A network + connection has no PID; you cannot signal it. All you can do is + deactivate and close it via delete-process */ + +DEFUN ("open-network-stream-internal", Fopen_network_stream_internal, 4, 5, 0, /* +Open a TCP connection for a service to a host. +Return a subprocess-object to represent the connection. +Input and output work as for subprocesses; `delete-process' closes it. + +NAME is name for process. It is modified if necessary to make it unique. +BUFFER is the buffer (or buffer-name) to associate with the process. + Process output goes at end of that buffer, unless you specify + an output stream or filter function to handle the output. + BUFFER may also be nil, meaning that this process is not associated + with any buffer. +Third arg is name of the host to connect to, or its IP address. +Fourth arg SERVICE is name of the service desired, or an integer + specifying a port number to connect to. +Fifth argument PROTOCOL is a network protocol. Currently 'tcp + (Transmission Control Protocol) and 'udp (User Datagram Protocol) are + supported. When omitted, 'tcp is assumed. + +Ouput via `process-send-string' and input via buffer or filter (see +`set-process-filter') are stream-oriented. That means UDP datagrams are +not guaranteed to be sent and received in discrete packets. (But small +datagrams around 500 bytes that are not truncated by `process-send-string' +are usually fine.) Note further that UDP protocol does not guard against +lost packets. +*/ + (name, buffer, host, service, protocol)) +{ + /* !!#### This function has not been Mule-ized */ + /* This function can GC */ + Lisp_Object proc = Qnil; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, ngcpro1; + void *inch, *outch; + + GCPRO5 (name, buffer, host, service, protocol); + CHECK_STRING (name); + + if (NILP(protocol)) + protocol = Qtcp; + else + CHECK_SYMBOL (protocol); + + /* Since this code is inside HAVE_SOCKETS, existence of + open_network_stream is mandatory */ + PROCMETH (open_network_stream, (name, host, service, protocol, + &inch, &outch)); + + if (!NILP (buffer)) + buffer = Fget_buffer_create (buffer); + proc = make_process_internal (name); + NGCPRO1 (proc); + + XPROCESS (proc)->pid = Fcons (service, host); + XPROCESS (proc)->buffer = buffer; + init_process_io_handles (XPROCESS (proc), (void*)inch, (void*)outch, + STREAM_NETWORK_CONNECTION); + + event_stream_select_process (XPROCESS (proc)); + + UNGCPRO; + NUNGCPRO; + return proc; +} + +#ifdef HAVE_MULTICAST + +DEFUN ("open-multicast-group-internal", Fopen_multicast_group_internal, 5, 5, 0, /* +Open a multicast connection on the specified dest/port/ttl. +Return a subprocess-object to represent the connection. +Input and output work as for subprocesses; `delete-process' closes it. + +NAME is name for process. It is modified if necessary to make it unique. +BUFFER is the buffer (or buffer-name) to associate with the process. + Process output goes at end of that buffer, unless you specify + an output stream or filter function to handle the output. + BUFFER may also be nil, meaning that this process is not associated + with any buffer. +Third, fourth and fifth args are the multicast destination group, port and ttl. + dest must be an internet address between 224.0.0.0 and 239.255.255.255 + port is a communication port like in traditional unicast + ttl is the time-to-live (15 for site, 63 for region and 127 for world) +*/ + (name, buffer, dest, port, ttl)) +{ + /* !!#### This function has not been Mule-ized */ + /* This function can GC */ + Lisp_Object proc = Qnil; + struct gcpro gcpro1; + void *inch, *outch; + + CHECK_STRING (name); + + /* Since this code is inside HAVE_MULTICAST, existence of + open_network_stream is mandatory */ + PROCMETH (open_multicast_group, (name, dest, port, ttl, + &inch, &outch)); + + if (!NILP (buffer)) + buffer = Fget_buffer_create (buffer); + + proc = make_process_internal (name); + GCPRO1 (proc); + + XPROCESS (proc)->pid = Fcons (port, dest); + XPROCESS (proc)->buffer = buffer; + init_process_io_handles (XPROCESS (proc), (void*)inch, (void*)outch, + STREAM_NETWORK_CONNECTION); + + event_stream_select_process (XPROCESS (proc)); + + UNGCPRO; + return proc; +} +#endif /* HAVE_MULTICAST */ + +#endif /* HAVE_SOCKETS */ + +Lisp_Object +canonicalize_host_name (Lisp_Object host) +{ + return PROCMETH_OR_GIVEN (canonicalize_host_name, (host), host); +} + + +DEFUN ("set-process-window-size", Fset_process_window_size, 3, 3, 0, /* +Tell PROCESS that it has logical window size HEIGHT and WIDTH. +*/ + (proc, height, width)) +{ + CHECK_PROCESS (proc); + CHECK_NATNUM (height); + CHECK_NATNUM (width); + return + MAYBE_INT_PROCMETH (set_window_size, (XPROCESS (proc), XINT (height), XINT (width))) <= 0 + ? Qnil : Qt; +} + + +/************************************************************************/ +/* Process I/O */ +/************************************************************************/ + +/* Read pending output from the process channel, + starting with our buffered-ahead character if we have one. + Yield number of characters read. + + This function reads at most 1024 bytes. + If you want to read all available subprocess output, + you must call it repeatedly until it returns zero. */ + +Charcount +read_process_output (Lisp_Object proc) +{ + /* This function can GC */ + Bytecount nbytes, nchars; + Bufbyte chars[1024]; + Lisp_Object outstream; + struct Lisp_Process *p = XPROCESS (proc); + + /* If there is a lot of output from the subprocess, the loop in + execute_internal_event() might call read_process_output() more + than once. If the filter that was executed from one of these + calls set the filter to t, we have to stop now. Return -1 rather + than 0 so execute_internal_event() doesn't close the process. + Really, the loop in execute_internal_event() should check itself + for a process-filter change, like in status_notify(); but the + struct Lisp_Process is not exported outside of this file. */ + if (NILP(p->pipe_instream)) + return -1; /* already closed */ + + if (!NILP (p->filter) && (p->filter_does_read)) + { + Lisp_Object filter_result; + + /* Some weird FSFmacs crap here with + Vdeactivate_mark and current_buffer->keymap */ + running_asynch_code = 1; + filter_result = call2_trapping_errors ("Error in process filter", + p->filter, proc, Qnil); + running_asynch_code = 0; + restore_match_data (); + CHECK_INT (filter_result); + return XINT (filter_result); + } + + nbytes = Lstream_read (XLSTREAM (DATA_INSTREAM(p)), chars, sizeof (chars)); + if (nbytes <= 0) return nbytes; + + nchars = bytecount_to_charcount (chars, nbytes); + outstream = p->filter; + if (!NILP (outstream)) + { + /* We used to bind inhibit-quit to t here, but + call2_trapping_errors() does that for us. */ + running_asynch_code = 1; + call2_trapping_errors ("Error in process filter", + outstream, proc, make_string (chars, nbytes)); + running_asynch_code = 0; + restore_match_data (); + return nchars; + } + + /* If no filter, write into buffer if it isn't dead. */ + if (!NILP (p->buffer) && BUFFER_LIVE_P (XBUFFER (p->buffer))) + { + Lisp_Object old_read_only = Qnil; + Bufpos old_point; + Bufpos old_begv; + Bufpos old_zv; + int old_zmacs_region_stays = zmacs_region_stays; + struct gcpro gcpro1, gcpro2; + struct buffer *buf = XBUFFER (p->buffer); + + GCPRO2 (proc, old_read_only); + + old_point = BUF_PT (buf); + old_begv = BUF_BEGV (buf); + old_zv = BUF_ZV (buf); + old_read_only = buf->read_only; + buf->read_only = Qnil; + + /* Insert new output into buffer + at the current end-of-output marker, + thus preserving logical ordering of input and output. */ + if (XMARKER (p->mark)->buffer) + BUF_SET_PT (buf, + bufpos_clip_to_bounds (old_begv, marker_position (p->mark), + old_zv)); + else + BUF_SET_PT (buf, old_zv); + + /* If the output marker is outside of the visible region, save + the restriction and widen. */ + if (! (BUF_BEGV (buf) <= BUF_PT (buf) && + BUF_PT (buf) <= BUF_ZV (buf))) + Fwiden (p->buffer); + + /* Make sure opoint floats ahead of any new text, just as point + would. */ + if (BUF_PT (buf) <= old_point) + old_point += nchars; + + /* Insert after old_begv, but before old_zv. */ + if (BUF_PT (buf) < old_begv) + old_begv += nchars; + if (BUF_PT (buf) <= old_zv) + old_zv += nchars; + +#if 0 + /* This screws up initial display of the window. jla */ + + /* Insert before markers in case we are inserting where + the buffer's mark is, and the user's next command is Meta-y. */ + buffer_insert_raw_string_1 (buf, -1, chars, + nbytes, INSDEL_BEFORE_MARKERS); +#else + buffer_insert_raw_string (buf, chars, nbytes); +#endif + + Fset_marker (p->mark, make_int (BUF_PT (buf)), p->buffer); + + MARK_MODELINE_CHANGED; + + /* If the restriction isn't what it should be, set it. */ + if (old_begv != BUF_BEGV (buf) || old_zv != BUF_ZV (buf)) + { + Fwiden(p->buffer); + old_begv = bufpos_clip_to_bounds (BUF_BEG (buf), + old_begv, + BUF_Z (buf)); + old_zv = bufpos_clip_to_bounds (BUF_BEG (buf), + old_zv, + BUF_Z (buf)); + Fnarrow_to_region (make_int (old_begv), make_int (old_zv), + p->buffer); + } + + /* Handling the process output should not deactivate the mark. */ + zmacs_region_stays = old_zmacs_region_stays; + buf->read_only = old_read_only; + old_point = bufpos_clip_to_bounds (BUF_BEGV (buf), + old_point, + BUF_ZV (buf)); + BUF_SET_PT (buf, old_point); + + UNGCPRO; + } + return nchars; +} + +/* Sending data to subprocess */ + +/* send some data to process PROC. If NONRELOCATABLE is non-NULL, it + specifies the address of the data. Otherwise, the data comes from the + object RELOCATABLE (either a string or a buffer). START and LEN + specify the offset and length of the data to send. + + Note that START and LEN are in Bufpos's if RELOCATABLE is a buffer, + and in Bytecounts otherwise. */ + +void +send_process (Lisp_Object proc, + Lisp_Object relocatable, CONST Bufbyte *nonrelocatable, + int start, int len) +{ + /* This function can GC */ + struct gcpro gcpro1, gcpro2; + Lisp_Object lstream = Qnil; + + GCPRO2 (proc, lstream); + + if (NILP (DATA_OUTSTREAM (XPROCESS (proc)))) + signal_simple_error ("Process not open for writing", proc); + + if (nonrelocatable) + lstream = + make_fixed_buffer_input_stream (nonrelocatable + start, len); + else if (BUFFERP (relocatable)) + lstream = make_lisp_buffer_input_stream (XBUFFER (relocatable), + start, start + len, 0); + else + lstream = make_lisp_string_input_stream (relocatable, start, len); + + PROCMETH (send_process, (proc, XLSTREAM (lstream))); + + UNGCPRO; + Lstream_delete (XLSTREAM (lstream)); +} + +DEFUN ("process-tty-name", Fprocess_tty_name, 1, 1, 0, /* +Return the name of the terminal PROCESS uses, or nil if none. +This is the terminal that the process itself reads and writes on, +not the name of the pty that Emacs uses to talk with that terminal. +*/ + (proc)) +{ + CHECK_PROCESS (proc); + return MAYBE_LISP_PROCMETH (get_tty_name, (XPROCESS (proc))); +} + +DEFUN ("set-process-buffer", Fset_process_buffer, 2, 2, 0, /* +Set buffer associated with PROCESS to BUFFER (a buffer, or nil). +*/ + (proc, buffer)) +{ + CHECK_PROCESS (proc); + if (!NILP (buffer)) + CHECK_BUFFER (buffer); + XPROCESS (proc)->buffer = buffer; + return buffer; +} + +DEFUN ("process-buffer", Fprocess_buffer, 1, 1, 0, /* +Return the buffer PROCESS is associated with. +Output from PROCESS is inserted in this buffer +unless PROCESS has a filter. +*/ + (proc)) +{ + CHECK_PROCESS (proc); + return XPROCESS (proc)->buffer; +} + +DEFUN ("process-mark", Fprocess_mark, 1, 1, 0, /* +Return the marker for the end of the last output from PROCESS. +*/ + (proc)) +{ + CHECK_PROCESS (proc); + return XPROCESS (proc)->mark; +} + +void +set_process_filter (Lisp_Object proc, Lisp_Object filter, int filter_does_read) +{ + CHECK_PROCESS (proc); + if (PROCESS_LIVE_P (proc)) { + if (EQ (filter, Qt)) + event_stream_unselect_process (XPROCESS (proc)); + else + event_stream_select_process (XPROCESS (proc)); + } + + XPROCESS (proc)->filter = filter; + XPROCESS (proc)->filter_does_read = filter_does_read; +} + +DEFUN ("set-process-filter", Fset_process_filter, 2, 2, 0, /* +Give PROCESS the filter function FILTER; nil means no filter. +t means stop accepting output from the process. +When a process has a filter, each time it does output +the entire string of output is passed to the filter. +The filter gets two arguments: the process and the string of output. +If the process has a filter, its buffer is not used for output. +*/ + (proc, filter)) +{ + set_process_filter (proc, filter, 0); + return filter; +} + +DEFUN ("process-filter", Fprocess_filter, 1, 1, 0, /* +Return the filter function of PROCESS; nil if none. +See `set-process-filter' for more info on filter functions. +*/ + (proc)) +{ + CHECK_PROCESS (proc); + return XPROCESS (proc)->filter; +} + +DEFUN ("process-send-region", Fprocess_send_region, 3, 3, 0, /* +Send current contents of region as input to PROCESS. +PROCESS may be a process name or an actual process. +Called from program, takes three arguments, PROCESS, START and END. +If the region is more than 500 or so characters long, +it is sent in several bunches. This may happen even for shorter regions. +Output from processes can arrive in between bunches. +*/ + (process, start, end)) +{ + /* This function can GC */ + Lisp_Object proc = get_process (process); + Bufpos st, en; + + get_buffer_range_char (current_buffer, start, end, &st, &en, 0); + + send_process (proc, Fcurrent_buffer (), 0, + st, en - st); + return Qnil; +} + +DEFUN ("process-send-string", Fprocess_send_string, 2, 4, 0, /* +Send PROCESS the contents of STRING as input. +PROCESS may be a process name or an actual process. +Optional arguments FROM and TO specify part of STRING, see `substring'. +If STRING is more than 500 or so characters long, +it is sent in several bunches. This may happen even for shorter strings. +Output from processes can arrive in between bunches. +*/ + (process, string, from, to)) +{ + /* This function can GC */ + Lisp_Object proc; + Bytecount len; + Bytecount bfr, bto; + + proc = get_process (process); + CHECK_STRING (string); + get_string_range_byte (string, from, to, &bfr, &bto, + GB_HISTORICAL_STRING_BEHAVIOR); + len = bto - bfr; + + send_process (proc, string, 0, bfr, len); + return Qnil; +} + +#ifdef FILE_CODING + +DEFUN ("process-input-coding-system", Fprocess_input_coding_system, 1, 1, 0, /* +Return PROCESS's input coding system. +*/ + (process)) +{ + process = get_process (process); + return decoding_stream_coding_system (XLSTREAM (XPROCESS (process)->coding_instream) ); +} + +DEFUN ("process-output-coding-system", Fprocess_output_coding_system, 1, 1, 0, /* +Return PROCESS's output coding system. +*/ + (process)) +{ + process = get_process (process); + return encoding_stream_coding_system (XLSTREAM (XPROCESS (process)->coding_outstream)); +} + +DEFUN ("process-coding-system", Fprocess_coding_system, 1, 1, 0, /* +Return a pair of coding-system for decoding and encoding of PROCESS. +*/ + (process)) +{ + process = get_process (process); + return Fcons (decoding_stream_coding_system + (XLSTREAM (XPROCESS (process)->coding_instream)), + encoding_stream_coding_system + (XLSTREAM (XPROCESS (process)->coding_outstream))); +} + +DEFUN ("set-process-input-coding-system", Fset_process_input_coding_system, + 2, 2, 0, /* +Set PROCESS's input coding system to CODESYS. +*/ + (process, codesys)) +{ + codesys = Fget_coding_system (codesys); + process = get_process (process); + set_decoding_stream_coding_system + (XLSTREAM (XPROCESS (process)->coding_instream), codesys); + return Qnil; +} + +DEFUN ("set-process-output-coding-system", Fset_process_output_coding_system, + 2, 2, 0, /* +Set PROCESS's output coding system to CODESYS. +*/ + (process, codesys)) +{ + codesys = Fget_coding_system (codesys); + process = get_process (process); + set_encoding_stream_coding_system + (XLSTREAM (XPROCESS (process)->coding_outstream), codesys); + return Qnil; +} + +DEFUN ("set-process-coding-system", Fset_process_coding_system, + 1, 3, 0, /* +Set coding-systems of PROCESS to DECODING and ENCODING. +*/ + (process, decoding, encoding)) +{ + if (!NILP (decoding)) + Fset_process_input_coding_system (process, decoding); + + if (!NILP (encoding)) + Fset_process_output_coding_system (process, encoding); + + return Qnil; +} + +#endif /* FILE_CODING */ + +/************************************************************************/ +/* process status */ +/************************************************************************/ + +static Lisp_Object +exec_sentinel_unwind (Lisp_Object datum) +{ + struct Lisp_Cons *d = XCONS (datum); + XPROCESS (d->car)->sentinel = d->cdr; + free_cons (d); + return Qnil; +} + +static void +exec_sentinel (Lisp_Object proc, Lisp_Object reason) +{ + /* This function can GC */ + int speccount = specpdl_depth (); + struct Lisp_Process *p = XPROCESS (proc); + Lisp_Object sentinel = p->sentinel; + + if (NILP (sentinel)) + return; + + /* Some weird FSFmacs crap here with + Vdeactivate_mark and current_buffer->keymap */ + + /* Zilch the sentinel while it's running, to avoid recursive invocations; + assure that it gets restored no matter how the sentinel exits. */ + p->sentinel = Qnil; + record_unwind_protect (exec_sentinel_unwind, noseeum_cons (proc, sentinel)); + /* We used to bind inhibit-quit to t here, but call2_trapping_errors() + does that for us. */ + running_asynch_code = 1; + call2_trapping_errors ("Error in process sentinel", sentinel, proc, reason); + running_asynch_code = 0; + restore_match_data (); + unbind_to (speccount, Qnil); +} + +DEFUN ("set-process-sentinel", Fset_process_sentinel, 2, 2, 0, /* +Give PROCESS the sentinel SENTINEL; nil for none. +The sentinel is called as a function when the process changes state. +It gets two arguments: the process, and a string describing the change. +*/ + (proc, sentinel)) +{ + CHECK_PROCESS (proc); + XPROCESS (proc)->sentinel = sentinel; + return sentinel; +} + +DEFUN ("process-sentinel", Fprocess_sentinel, 1, 1, 0, /* +Return the sentinel of PROCESS; nil if none. +See `set-process-sentinel' for more info on sentinels. +*/ + (proc)) +{ + CHECK_PROCESS (proc); + return XPROCESS (proc)->sentinel; +} + + +CONST char * +signal_name (int signum) +{ + if (signum >= 0 && signum < NSIG) + return (CONST char *) sys_siglist[signum]; + + return (CONST char *) GETTEXT ("unknown signal"); +} + +void +update_process_status (Lisp_Object p, + Lisp_Object status_symbol, + int exit_code, + int core_dumped) +{ + XPROCESS (p)->tick++; + process_tick++; + XPROCESS (p)->status_symbol = status_symbol; + XPROCESS (p)->exit_code = exit_code; + XPROCESS (p)->core_dumped = core_dumped; +} + +/* Return a string describing a process status list. */ + +static Lisp_Object +status_message (struct Lisp_Process *p) +{ + Lisp_Object symbol = p->status_symbol; + int code = p->exit_code; + int coredump = p->core_dumped; + Lisp_Object string, string2; + + if (EQ (symbol, Qsignal) || EQ (symbol, Qstop)) + { + string = build_string (signal_name (code)); + if (coredump) + string2 = build_translated_string (" (core dumped)\n"); + else + string2 = build_string ("\n"); + set_string_char (XSTRING (string), 0, + DOWNCASE (current_buffer, + string_char (XSTRING (string), 0))); + return concat2 (string, string2); + } + else if (EQ (symbol, Qexit)) + { + if (code == 0) + return build_translated_string ("finished\n"); + string = Fnumber_to_string (make_int (code)); + if (coredump) + string2 = build_translated_string (" (core dumped)\n"); + else + string2 = build_string ("\n"); + return concat2 (build_translated_string ("exited abnormally with code "), + concat2 (string, string2)); + } + else + return Fcopy_sequence (Fsymbol_name (symbol)); +} + +/* Tell status_notify() to check for terminated processes. We do this + because on some systems we sometimes miss SIGCHLD calls. (Not sure + why.) */ + +void +kick_status_notify (void) +{ + process_tick++; +} + + +/* Report all recent events of a change in process status + (either run the sentinel or output a message). + This is done while Emacs is waiting for keyboard input. */ + +void +status_notify (void) +{ + /* This function can GC */ + Lisp_Object tail = Qnil; + Lisp_Object symbol = Qnil; + Lisp_Object msg = Qnil; + struct gcpro gcpro1, gcpro2, gcpro3; + /* process_tick is volatile, so we have to remember it now. + Otherwise, we get a race condition is SIGCHLD happens during + this function. + + (Actually, this is not the case anymore. The code to + update the process structures has been moved out of the + SIGCHLD handler. But for the moment I'm leaving this + stuff in -- it can't hurt.) */ + int temp_process_tick; + + MAYBE_PROCMETH (reap_exited_processes, ()); + + temp_process_tick = process_tick; + + if (update_tick == temp_process_tick) + return; + + /* We need to gcpro tail; if read_process_output calls a filter + which deletes a process and removes the cons to which tail points + from Vprocess_alist, and then causes a GC, tail is an unprotected + reference. */ + GCPRO3 (tail, symbol, msg); + + for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail)) + { + Lisp_Object proc = XCAR (tail); + struct Lisp_Process *p = XPROCESS (proc); + /* p->tick is also volatile. Same thing as above applies. */ + int this_process_tick; + + /* #### extra check for terminated processes, in case a SIGCHLD + got missed (this seems to happen sometimes, I'm not sure why). + */ + if (INTP (p->pid)) + MAYBE_PROCMETH (update_status_if_terminated, (p)); + + this_process_tick = p->tick; + if (this_process_tick != p->update_tick) + { + p->update_tick = this_process_tick; + + /* If process is still active, read any output that remains. */ + while (!EQ (p->filter, Qt) + && read_process_output (proc) > 0) + ; + + /* Get the text to use for the message. */ + msg = status_message (p); + + /* If process is terminated, deactivate it or delete it. */ + symbol = p->status_symbol; + + if (EQ (symbol, Qsignal) + || EQ (symbol, Qexit)) + { + if (delete_exited_processes) + remove_process (proc); + else + deactivate_process (proc); + } + + /* Now output the message suitably. */ + if (!NILP (p->sentinel)) + exec_sentinel (proc, msg); + /* Don't bother with a message in the buffer + when a process becomes runnable. */ + else if (!EQ (symbol, Qrun) && !NILP (p->buffer)) + { + Lisp_Object old_read_only = Qnil; + Lisp_Object old = Fcurrent_buffer (); + Bufpos opoint; + struct gcpro ngcpro1, ngcpro2; + + /* Avoid error if buffer is deleted + (probably that's why the process is dead, too) */ + if (!BUFFER_LIVE_P (XBUFFER (p->buffer))) + continue; + + NGCPRO2 (old, old_read_only); + Fset_buffer (p->buffer); + opoint = BUF_PT (current_buffer); + /* Insert new output into buffer + at the current end-of-output marker, + thus preserving logical ordering of input and output. */ + if (XMARKER (p->mark)->buffer) + BUF_SET_PT (current_buffer, marker_position (p->mark)); + else + BUF_SET_PT (current_buffer, BUF_ZV (current_buffer)); + if (BUF_PT (current_buffer) <= opoint) + opoint += (string_char_length (XSTRING (msg)) + + string_char_length (XSTRING (p->name)) + + 10); + + old_read_only = current_buffer->read_only; + current_buffer->read_only = Qnil; + buffer_insert_c_string (current_buffer, "\nProcess "); + Finsert (1, &p->name); + buffer_insert_c_string (current_buffer, " "); + Finsert (1, &msg); + current_buffer->read_only = old_read_only; + Fset_marker (p->mark, make_int (BUF_PT (current_buffer)), + p->buffer); + + opoint = bufpos_clip_to_bounds(BUF_BEGV (XBUFFER (p->buffer)), + opoint, + BUF_ZV (XBUFFER (p->buffer))); + BUF_SET_PT (current_buffer, opoint); + Fset_buffer (old); + NUNGCPRO; + } + } + } /* end for */ + + /* in case buffers use %s in modeline-format */ + MARK_MODELINE_CHANGED; + redisplay (); + + update_tick = temp_process_tick; + + UNGCPRO; +} + +DEFUN ("process-status", Fprocess_status, 1, 1, 0, /* +Return the status of PROCESS. +This is a symbol, one of these: + +run -- for a process that is running. +stop -- for a process stopped but continuable. +exit -- for a process that has exited. +signal -- for a process that has got a fatal signal. +open -- for a network stream connection that is open. +closed -- for a network stream connection that is closed. +nil -- if arg is a process name and no such process exists. + +PROCESS may be a process, a buffer, the name of a process or buffer, or +nil, indicating the current buffer's process. +*/ + (proc)) +{ + Lisp_Object status_symbol; + + if (STRINGP (proc)) + proc = Fget_process (proc); + else + proc = get_process (proc); + + if (NILP (proc)) + return Qnil; + + status_symbol = XPROCESS (proc)->status_symbol; + if (network_connection_p (proc)) + { + if (EQ (status_symbol, Qrun)) + status_symbol = Qopen; + else if (EQ (status_symbol, Qexit)) + status_symbol = Qclosed; + } + return status_symbol; +} + +DEFUN ("process-exit-status", Fprocess_exit_status, 1, 1, 0, /* +Return the exit status of PROCESS or the signal number that killed it. +If PROCESS has not yet exited or died, return 0. +*/ + (proc)) +{ + CHECK_PROCESS (proc); + return make_int (XPROCESS (proc)->exit_code); +} + + + +/* send a signal number SIGNO to PROCESS. + CURRENT_GROUP means send to the process group that currently owns + the terminal being used to communicate with PROCESS. + This is used for various commands in shell mode. + If NOMSG is zero, insert signal-announcements into process's buffers + right away. + + If we can, we try to signal PROCESS by sending control characters + down the pty. This allows us to signal inferiors who have changed + their uid, for which killpg would return an EPERM error. */ + +static void +process_send_signal (Lisp_Object process, int signo, + int current_group, int nomsg) +{ + /* This function can GC */ + Lisp_Object proc = get_process (process); + + if (network_connection_p (proc)) + error ("Network connection %s is not a subprocess", + XSTRING_DATA (XPROCESS(proc)->name)); + if (!PROCESS_LIVE_P (proc)) + error ("Process %s is not active", + XSTRING_DATA (XPROCESS(proc)->name)); + + MAYBE_PROCMETH (kill_child_process, (proc, signo, current_group, nomsg)); +} + +DEFUN ("interrupt-process", Finterrupt_process, 0, 2, 0, /* +Interrupt process PROCESS. May be process or name of one. +Nil or no arg means current buffer's process. +Second arg CURRENT-GROUP non-nil means send signal to +the current process-group of the process's controlling terminal +rather than to the process's own process group. +If the process is a shell, this means interrupt current subjob +rather than the shell. +*/ + (process, current_group)) +{ + /* This function can GC */ + process_send_signal (process, SIGINT, !NILP (current_group), 0); + return process; +} + +DEFUN ("kill-process", Fkill_process, 0, 2, 0, /* +Kill process PROCESS. May be process or name of one. +See function `interrupt-process' for more details on usage. +*/ + (process, current_group)) +{ + /* This function can GC */ +#ifdef SIGKILL + process_send_signal (process, SIGKILL, !NILP (current_group), 0); +#else + error ("kill-process: Not supported on this system"); +#endif + return process; +} + +DEFUN ("quit-process", Fquit_process, 0, 2, 0, /* +Send QUIT signal to process PROCESS. May be process or name of one. +See function `interrupt-process' for more details on usage. +*/ + (process, current_group)) +{ + /* This function can GC */ +#ifdef SIGQUIT + process_send_signal (process, SIGQUIT, !NILP (current_group), 0); +#else + error ("quit-process: Not supported on this system"); +#endif + return process; +} + +DEFUN ("stop-process", Fstop_process, 0, 2, 0, /* +Stop process PROCESS. May be process or name of one. +See function `interrupt-process' for more details on usage. +*/ + (process, current_group)) +{ + /* This function can GC */ +#ifdef SIGTSTP + process_send_signal (process, SIGTSTP, !NILP (current_group), 0); +#else + error ("stop-process: Not supported on this system"); +#endif + return process; +} + +DEFUN ("continue-process", Fcontinue_process, 0, 2, 0, /* +Continue process PROCESS. May be process or name of one. +See function `interrupt-process' for more details on usage. +*/ + (process, current_group)) +{ + /* This function can GC */ +#ifdef SIGCONT + process_send_signal (process, SIGCONT, !NILP (current_group), 0); +#else + error ("continue-process: Not supported on this system"); +#endif + return process; +} + +DEFUN ("signal-process", Fsignal_process, 2, 2, + "nProcess number: \nnSignal code: ", /* +Send the process with process id PID the signal with code SIGCODE. +PID must be an integer. The process need not be a child of this Emacs. +SIGCODE may be an integer, or a symbol whose name is a signal name. +*/ + (pid, sigcode)) +{ + CHECK_INT (pid); + + if (INTP (sigcode)) + ; + else + { + Bufbyte *name; + + CHECK_SYMBOL (sigcode); + name = string_data (XSYMBOL (sigcode)->name); + +#define handle_signal(signal) \ + else if (!strcmp ((CONST char *) name, #signal)) \ + XSETINT (sigcode, signal) + + if (0) + ; + handle_signal (SIGINT); /* ANSI */ + handle_signal (SIGILL); /* ANSI */ + handle_signal (SIGABRT); /* ANSI */ + handle_signal (SIGFPE); /* ANSI */ + handle_signal (SIGSEGV); /* ANSI */ + handle_signal (SIGTERM); /* ANSI */ + +#ifdef SIGHUP + handle_signal (SIGHUP); /* POSIX */ +#endif +#ifdef SIGQUIT + handle_signal (SIGQUIT); /* POSIX */ +#endif +#ifdef SIGTRAP + handle_signal (SIGTRAP); /* POSIX */ +#endif +#ifdef SIGKILL + handle_signal (SIGKILL); /* POSIX */ +#endif +#ifdef SIGUSR1 + handle_signal (SIGUSR1); /* POSIX */ +#endif +#ifdef SIGUSR2 + handle_signal (SIGUSR2); /* POSIX */ +#endif +#ifdef SIGPIPE + handle_signal (SIGPIPE); /* POSIX */ +#endif +#ifdef SIGALRM + handle_signal (SIGALRM); /* POSIX */ +#endif +#ifdef SIGCHLD + handle_signal (SIGCHLD); /* POSIX */ +#endif +#ifdef SIGCONT + handle_signal (SIGCONT); /* POSIX */ +#endif +#ifdef SIGSTOP + handle_signal (SIGSTOP); /* POSIX */ +#endif +#ifdef SIGTSTP + handle_signal (SIGTSTP); /* POSIX */ +#endif +#ifdef SIGTTIN + handle_signal (SIGTTIN); /* POSIX */ +#endif +#ifdef SIGTTOU + handle_signal (SIGTTOU); /* POSIX */ +#endif + +#ifdef SIGBUS + handle_signal (SIGBUS); /* XPG5 */ +#endif +#ifdef SIGPOLL + handle_signal (SIGPOLL); /* XPG5 */ +#endif +#ifdef SIGPROF + handle_signal (SIGPROF); /* XPG5 */ +#endif +#ifdef SIGSYS + handle_signal (SIGSYS); /* XPG5 */ +#endif +#ifdef SIGURG + handle_signal (SIGURG); /* XPG5 */ +#endif +#ifdef SIGXCPU + handle_signal (SIGXCPU); /* XPG5 */ +#endif +#ifdef SIGXFSZ + handle_signal (SIGXFSZ); /* XPG5 */ +#endif +#ifdef SIGVTALRM + handle_signal (SIGVTALRM); /* XPG5 */ +#endif + +#ifdef SIGIO + handle_signal (SIGIO); /* BSD 4.2 */ +#endif +#ifdef SIGWINCH + handle_signal (SIGWINCH); /* BSD 4.3 */ +#endif + +#ifdef SIGEMT + handle_signal (SIGEMT); +#endif +#ifdef SIGINFO + handle_signal (SIGINFO); +#endif +#ifdef SIGHWE + handle_signal (SIGHWE); +#endif +#ifdef SIGPRE + handle_signal (SIGPRE); +#endif +#ifdef SIGUME + handle_signal (SIGUME); +#endif +#ifdef SIGDLK + handle_signal (SIGDLK); +#endif +#ifdef SIGCPULIM + handle_signal (SIGCPULIM); +#endif +#ifdef SIGIOT + handle_signal (SIGIOT); +#endif +#ifdef SIGLOST + handle_signal (SIGLOST); +#endif +#ifdef SIGSTKFLT + handle_signal (SIGSTKFLT); +#endif +#ifdef SIGUNUSED + handle_signal (SIGUNUSED); +#endif +#ifdef SIGDANGER + handle_signal (SIGDANGER); /* AIX */ +#endif +#ifdef SIGMSG + handle_signal (SIGMSG); +#endif +#ifdef SIGSOUND + handle_signal (SIGSOUND); +#endif +#ifdef SIGRETRACT + handle_signal (SIGRETRACT); +#endif +#ifdef SIGGRANT + handle_signal (SIGGRANT); +#endif +#ifdef SIGPWR + handle_signal (SIGPWR); +#endif + else + error ("Undefined signal name %s", name); + } + +#undef handle_signal + + return make_int (PROCMETH_OR_GIVEN (kill_process_by_pid, + (XINT (pid), XINT (sigcode)), -1)); +} + +DEFUN ("process-send-eof", Fprocess_send_eof, 0, 1, 0, /* +Make PROCESS see end-of-file in its input. +PROCESS may be a process, a buffer, the name of a process or buffer, or +nil, indicating the current buffer's process. +If PROCESS is a network connection, or is a process communicating +through a pipe (as opposed to a pty), then you cannot send any more +text to PROCESS after you call this function. +*/ + (process)) +{ + /* This function can GC */ + Lisp_Object proc = get_process (process); + + /* Make sure the process is really alive. */ + if (! EQ (XPROCESS (proc)->status_symbol, Qrun)) + error ("Process %s not running", XSTRING_DATA (XPROCESS (proc)->name)); + + if (!MAYBE_INT_PROCMETH (process_send_eof, (proc))) + { + if (!NILP (DATA_OUTSTREAM (XPROCESS (proc)))) + { + Lstream_close (XLSTREAM (DATA_OUTSTREAM (XPROCESS (proc)))); + event_stream_delete_stream_pair (Qnil, XPROCESS (proc)->pipe_outstream); + XPROCESS (proc)->pipe_outstream = Qnil; +#ifdef FILE_CODING + XPROCESS (proc)->coding_outstream = Qnil; +#endif + } + } + + return process; +} + + +/************************************************************************/ +/* deleting a process */ +/************************************************************************/ + +void +deactivate_process (Lisp_Object proc) +{ + struct Lisp_Process *p = XPROCESS (proc); + USID usid; + + /* It's possible that we got as far in the process-creation + process as creating the descriptors but didn't get so + far as selecting the process for input. In this + case, p->pid is nil: p->pid is set at the same time that + the process is selected for input. */ + /* #### The comment does not look correct. event_stream_unselect_process + is guarded by process->selected, so this is not a problem. - kkm*/ + /* Must call this before setting the streams to nil */ + event_stream_unselect_process (p); + + if (!NILP (DATA_OUTSTREAM (p))) + Lstream_close (XLSTREAM (DATA_OUTSTREAM (p))); + if (!NILP (DATA_INSTREAM (p))) + Lstream_close (XLSTREAM (DATA_INSTREAM (p))); + + /* Provide minimal implementation for deactivate_process + if there's no process-specific one */ + if (HAS_PROCMETH_P (deactivate_process)) + usid = PROCMETH (deactivate_process, (p)); + else + usid = event_stream_delete_stream_pair (p->pipe_instream, + p->pipe_outstream); + + if (usid != USID_DONTHASH) + remhash ((CONST void*)usid, usid_to_process); + + p->pipe_instream = Qnil; + p->pipe_outstream = Qnil; +#ifdef FILE_CODING + p->coding_instream = Qnil; + p->coding_outstream = Qnil; +#endif +} + +static void +remove_process (Lisp_Object proc) +{ + Vprocess_list = delq_no_quit (proc, Vprocess_list); + Fset_marker (XPROCESS (proc)->mark, Qnil, Qnil); + + deactivate_process (proc); +} + +DEFUN ("delete-process", Fdelete_process, 1, 1, 0, /* +Delete PROCESS: kill it and forget about it immediately. +PROCESS may be a process or the name of one, or a buffer name. +*/ + (proc)) +{ + /* This function can GC */ + struct Lisp_Process *p; + proc = get_process (proc); + p = XPROCESS (proc); + if (network_connection_p (proc)) + { + p->status_symbol = Qexit; + p->exit_code = 0; + p->core_dumped = 0; + p->tick++; + process_tick++; + } + else if (!NILP(p->pipe_instream)) + { + Fkill_process (proc, Qnil); + /* Do this now, since remove_process will make sigchld_handler do nothing. */ + p->status_symbol = Qsignal; + p->exit_code = SIGKILL; + p->core_dumped = 0; + p->tick++; + process_tick++; + status_notify (); + } + remove_process (proc); + return Qnil; +} + +/* Kill all processes associated with `buffer'. + If `buffer' is nil, kill all processes */ + +void +kill_buffer_processes (Lisp_Object buffer) +{ + Lisp_Object tail; + + for (tail = Vprocess_list; CONSP (tail); + tail = XCDR (tail)) + { + Lisp_Object proc = XCAR (tail); + if (PROCESSP (proc) + && (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer))) + { + if (network_connection_p (proc)) + Fdelete_process (proc); + else if (!NILP (XPROCESS (proc)->pipe_instream)) + process_send_signal (proc, SIGHUP, 0, 1); + } + } +} + +DEFUN ("process-kill-without-query", Fprocess_kill_without_query, 1, 2, 0, /* +Say no query needed if PROCESS is running when Emacs is exited. +Optional second argument if non-nil says to require a query. +Value is t if a query was formerly required. +*/ + (proc, require_query_p)) +{ + int tem; + + CHECK_PROCESS (proc); + tem = XPROCESS (proc)->kill_without_query; + XPROCESS (proc)->kill_without_query = NILP (require_query_p); + + return tem ? Qnil : Qt; +} + +DEFUN ("process-kill-without-query-p", Fprocess_kill_without_query_p, 1, 1, 0, /* +Whether PROC will be killed without query if running when emacs is exited. +*/ + (proc)) +{ + CHECK_PROCESS (proc); + return XPROCESS (proc)->kill_without_query ? Qt : Qnil; +} + + +/* This is not named init_process in order to avoid a conflict with NS 3.3 */ +void +init_xemacs_process (void) +{ + MAYBE_PROCMETH (init_process, ()); + + Vprocess_list = Qnil; + + if (usid_to_process) + clrhash (usid_to_process); + else + usid_to_process = make_hash_table (32); +} + +#if 0 + +xxDEFUN ("process-connection", Fprocess_connection, 0, 1, 0, /* +Return the connection type of `PROCESS'. This can be nil (pipe), +t or pty (pty) or stream (socket connection). +*/ + (process)) +{ + return XPROCESS (process)->type; +} + +#endif /* 0 */ + +void +syms_of_process (void) +{ + defsymbol (&Qprocessp, "processp"); + defsymbol (&Qrun, "run"); + defsymbol (&Qstop, "stop"); + defsymbol (&Qopen, "open"); + defsymbol (&Qclosed, "closed"); + + defsymbol (&Qtcp, "tcp"); + defsymbol (&Qudp, "udp"); + +#ifdef HAVE_MULTICAST + defsymbol(&Qmulticast, "multicast"); /* Used for occasional warnings */ +#endif + + DEFSUBR (Fprocessp); + DEFSUBR (Fget_process); + DEFSUBR (Fget_buffer_process); + DEFSUBR (Fdelete_process); + DEFSUBR (Fprocess_status); + DEFSUBR (Fprocess_exit_status); + DEFSUBR (Fprocess_id); + DEFSUBR (Fprocess_name); + DEFSUBR (Fprocess_tty_name); + DEFSUBR (Fprocess_command); + DEFSUBR (Fset_process_buffer); + DEFSUBR (Fprocess_buffer); + DEFSUBR (Fprocess_mark); + DEFSUBR (Fset_process_filter); + DEFSUBR (Fprocess_filter); + DEFSUBR (Fset_process_window_size); + DEFSUBR (Fset_process_sentinel); + DEFSUBR (Fprocess_sentinel); + DEFSUBR (Fprocess_kill_without_query); + DEFSUBR (Fprocess_kill_without_query_p); + DEFSUBR (Fprocess_list); + DEFSUBR (Fstart_process_internal); +#ifdef HAVE_SOCKETS + DEFSUBR (Fopen_network_stream_internal); +#ifdef HAVE_MULTICAST + DEFSUBR (Fopen_multicast_group_internal); +#endif /* HAVE_MULTICAST */ +#endif /* HAVE_SOCKETS */ + DEFSUBR (Fprocess_send_region); + DEFSUBR (Fprocess_send_string); + DEFSUBR (Finterrupt_process); + DEFSUBR (Fkill_process); + DEFSUBR (Fquit_process); + DEFSUBR (Fstop_process); + DEFSUBR (Fcontinue_process); + DEFSUBR (Fprocess_send_eof); + DEFSUBR (Fsignal_process); +/* DEFSUBR (Fprocess_connection); */ +#ifdef FILE_CODING + DEFSUBR (Fprocess_input_coding_system); + DEFSUBR (Fprocess_output_coding_system); + DEFSUBR (Fset_process_input_coding_system); + DEFSUBR (Fset_process_output_coding_system); + DEFSUBR (Fprocess_coding_system); + DEFSUBR (Fset_process_coding_system); +#endif /* FILE_CODING */ +} + +void +vars_of_process (void) +{ + Fprovide (intern ("subprocesses")); +#ifdef HAVE_SOCKETS + Fprovide (intern ("network-streams")); +#ifdef HAVE_MULTICAST + Fprovide (intern ("multicast")); +#endif /* HAVE_MULTICAST */ +#endif /* HAVE_SOCKETS */ + staticpro (&Vprocess_list); + + DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes /* +*Non-nil means delete processes immediately when they exit. +nil means don't delete them until `list-processes' is run. +*/ ); + + delete_exited_processes = 1; + + DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type /* +Control type of device used to communicate with subprocesses. +Values are nil to use a pipe, or t or `pty' to use a pty. +The value has no effect if the system has no ptys or if all ptys are busy: +then a pipe is used in any case. +The value takes effect when `start-process' is called. +*/ ); + Vprocess_connection_type = Qt; + + DEFVAR_BOOL ("windowed-process-io", &windowed_process_io /* +Enables input/output on standard handles of a windowed process. +When this variable is nil (the default), XEmacs does not attempt to read +standard output handle of a windowed process. Instead, the process is +immediately marked as exited immediately upon successful launching. This is +done because normal windowed processes do not use standard I/O, as they are +not connected to any console. + +When launching a specially crafted windowed process, which expects to be +launched by XEmacs, or by other program which pipes its standard input and +output, this variable must be set to non-nil, in which case XEmacs will +treat this process just like a console process. + +NOTE: You should never set this variable, only bind it. + +Only Windows processes can be "windowed" or "console". This variable has no +effect on UNIX processes, because all UNIX processes are "console". +*/ ); + windowed_process_io = 0; + +#ifdef PROCESS_IO_BLOCKING + DEFVAR_LISP ("network-stream-blocking-port-list", &network_stream_blocking_port_list /* +List of port numbers or port names to set a blocking I/O mode with connection. +Nil value means to set a default(non-blocking) I/O mode. +The value takes effect when `open-network-stream-internal' is called. +*/ ); + network_stream_blocking_port_list = Qnil; +#endif /* PROCESS_IO_BLOCKING */ +} + +#endif /* not NO_SUBPROCESSES */