X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/4a2f9c6aefdb14ce8c34ace4d7573b89d1cc13b7..6c743efb4066dedee5e2a55b539e850a357ce8cb:/src/process.c diff --git a/src/process.c b/src/process.c index a638763062..90a5a2f511 100644 --- a/src/process.c +++ b/src/process.c @@ -106,6 +106,8 @@ Boston, MA 02111-1307, USA. */ #include "commands.h" #include "frame.h" #include "blockinput.h" +#include "keyboard.h" +#include "dispextern.h" #define max(a, b) ((a) > (b) ? (a) : (b)) @@ -266,7 +268,7 @@ extern int timers_run; /* Maximum number of bytes to send to a pty without an eof. */ static int pty_max_bytes; -extern Lisp_Object Vfile_name_coding_system; +extern Lisp_Object Vfile_name_coding_system, Vdefault_file_name_coding_system; #ifdef HAVE_PTYS /* The file name of the pty opened by allocate_pty. */ @@ -279,6 +281,7 @@ static char pty_name[24]; Lisp_Object status_convert (); +void update_status (p) struct Lisp_Process *p; { @@ -391,7 +394,7 @@ int allocate_pty () { struct stat stb; - register c, i; + register int c, i; int fd; /* Some systems name their pseudoterminals so that there are gaps in @@ -512,6 +515,7 @@ make_process (name) return val; } +void remove_process (proc) register Lisp_Object proc; { @@ -543,7 +547,7 @@ DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0, } DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0, - "Return the (or, a) process associated with BUFFER.\n\ + "Return the (or a) process associated with BUFFER.\n\ BUFFER may be a buffer or the name of one.") (buffer) register Lisp_Object buffer; @@ -631,7 +635,8 @@ nil, indicating the current buffer's process.") } DEFUN ("process-status", Fprocess_status, Sprocess_status, 1, 1, 0, - "Return the status of PROCESS: a symbol, one of these:\n\ + "Return the status of PROCESS.\n\ +The returned value is one of the following symbols:\n\ run -- for a process that is running.\n\ stop -- for a process stopped but continuable.\n\ exit -- for a process that has exited.\n\ @@ -639,7 +644,7 @@ signal -- for a process that has got a fatal signal.\n\ open -- for a network stream connection that is open.\n\ closed -- for a network stream connection that is closed.\n\ nil -- if arg is a process name and no such process exists.\n\ -PROCESS may be a process, a buffer, the name of a process or buffer, or\n\ +PROCESS may be a process, a buffer, the name of a process, or\n\ nil, indicating the current buffer's process.") (process) register Lisp_Object process; @@ -747,8 +752,7 @@ DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer, DEFUN ("process-buffer", Fprocess_buffer, Sprocess_buffer, 1, 1, 0, "Return the buffer PROCESS is associated with.\n\ -Output from PROCESS is inserted in this buffer\n\ -unless PROCESS has a filter.") +Output from PROCESS is inserted in this buffer unless PROCESS has a filter.") (process) register Lisp_Object process; { @@ -843,6 +847,45 @@ DEFUN ("set-process-window-size", Fset_process_window_size, return Qt; } +DEFUN ("set-process-inherit-coding-system-flag", + Fset_process_inherit_coding_system_flag, + Sset_process_inherit_coding_system_flag, 2, 2, 0, + "Determine whether buffer of PROCESS will inherit coding-system.\n\ +If the second argument FLAG is non-nil, then the variable\n\ +`buffer-file-coding-system' of the buffer associated with PROCESS\n\ +will be bound to the value of the coding system used to decode\n\ +the process output.\n\ +\n\ +This is useful when the coding system specified for the process buffer\n\ +leaves either the character code conversion or the end-of-line conversion\n\ +unspecified, or if the coding system used to decode the process output\n\ +is more appropriate for saving the process buffer.\n\ +\n\ +Binding the variable `inherit-process-coding-system' to non-nil before\n\ +starting the process is an alternative way of setting the inherit flag\n\ +for the process which will run.") + (process, flag) + register Lisp_Object process, flag; +{ + CHECK_PROCESS (process, 0); + XPROCESS (process)->inherit_coding_system_flag = flag; + return flag; +} + +DEFUN ("process-inherit-coding-system-flag", + Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag, + 1, 1, 0, + "Return the value of inherit-coding-system flag for PROCESS.\n\ +If this flag is t, `buffer-file-coding-system' of the buffer\n\ +associated with PROCESS will inherit the coding system used to decode\n\ +the process output.") + (process) + register Lisp_Object process; +{ + CHECK_PROCESS (process, 0); + return XPROCESS (process)->inherit_coding_system_flag; +} + DEFUN ("process-kill-without-query", Fprocess_kill_without_query, Sprocess_kill_without_query, 1, 2, 0, "Say no query needed if PROCESS is running when Emacs is exited.\n\ @@ -874,9 +917,9 @@ For a net connection, the value is a cons cell of the form (HOST SERVICE).") #if 0 /* Turned off because we don't currently record this info in the process. Perhaps add it. */ DEFUN ("process-connection", Fprocess_connection, Sprocess_connection, 1, 1, 0, - "Return the connection type of `PROCESS'.\n\ -The value is `nil' for a pipe,\n\ -`t' or `pty' for a pty, or `stream' for a socket connection.") + "Return the connection type of PROCESS.\n\ +The value is nil for a pipe, t or `pty' for a pty, or `stream' for\n\ +a socket connection.") (process) Lisp_Object process; { @@ -1004,8 +1047,8 @@ Proc Status Buffer Tty Command\n\ DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 0, "", "Display a list of all processes.\n\ -\(Any processes listed as Exited or Signaled are actually eliminated\n\ -after the listing is made.)") +Any process listed as exited or signaled is actually eliminated\n\ +after the listing is made.") () { internal_with_output_to_temp_buffer ("*Process List*", @@ -1033,7 +1076,7 @@ BUFFER is the buffer or (buffer-name) to associate with the process.\n\ an output stream or filter function to handle the output.\n\ BUFFER may be also nil, meaning that this process is not associated\n\ with any buffer.\n\ -Third arg is program file name. It is searched for as in the shell.\n\ +Third arg is program file name. It is searched for in PATH.\n\ Remaining arguments are strings to give program as arguments.") (nargs, args) int nargs; @@ -1089,12 +1132,12 @@ Remaining arguments are strings to give program as arguments.") #ifdef VMS /* Make a one member argv with all args concatenated together separated by a blank. */ - len = XSTRING (program)->size_byte + 2; + len = STRING_BYTES (XSTRING (program)) + 2; for (i = 3; i < nargs; i++) { tem = args[i]; CHECK_STRING (tem, i); - len += XSTRING (tem)->size_byte + 1; /* count the blank */ + len += STRING_BYTES (XSTRING (tem)) + 1; /* count the blank */ } new_argv = (unsigned char *) alloca (len); strcpy (new_argv, XSTRING (program)->data); @@ -1163,69 +1206,60 @@ Remaining arguments are strings to give program as arguments.") BUF_ZV (XBUFFER (buffer)), BUF_ZV_BYTE (XBUFFER (buffer))); - if (!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters) - || NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters)) - { - XPROCESS (proc)->decode_coding_system = Qnil; - XPROCESS (proc)->encode_coding_system = Qnil; - } - else - { - /* Setup coding systems for communicating with the process. */ - /* Qt denotes we have not yet called Ffind_operation_coding_system. */ - Lisp_Object coding_systems = Qt; - Lisp_Object val, *args2; - struct gcpro gcpro1; + { + /* Decide coding systems for communicating with the process. Here + we don't setup the structure coding_system nor pay attention to + unibyte mode. They are done in create_process. */ - if (!NILP (Vcoding_system_for_read)) - val = Vcoding_system_for_read; - else if (NILP (current_buffer->enable_multibyte_characters)) - val = Qemacs_mule; - else - { - args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2); - args2[0] = Qstart_process; - for (i = 0; i < nargs; i++) args2[i + 1] = args[i]; - GCPRO1 (proc); - coding_systems = Ffind_operation_coding_system (nargs + 1, args2); - UNGCPRO; - if (CONSP (coding_systems)) - val = XCONS (coding_systems)->car; - else if (CONSP (Vdefault_process_coding_system)) - val = XCONS (Vdefault_process_coding_system)->car; - else - val = Qnil; - } - XPROCESS (proc)->decode_coding_system = val; + /* Qt denotes we have not yet called Ffind_operation_coding_system. */ + Lisp_Object coding_systems = Qt; + Lisp_Object val, *args2; + struct gcpro gcpro1; - if (!NILP (Vcoding_system_for_write)) - val = Vcoding_system_for_write; - else if (NILP (current_buffer->enable_multibyte_characters)) - val = Qnil; - else - { - if (EQ (coding_systems, Qt)) - { - args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof args2); - args2[0] = Qstart_process; - for (i = 0; i < nargs; i++) args2[i + 1] = args[i]; - GCPRO1 (proc); - coding_systems = - Ffind_operation_coding_system (nargs + 1, args2); - UNGCPRO; - } - if (CONSP (coding_systems)) - val = XCONS (coding_systems)->cdr; - else if (CONSP (Vdefault_process_coding_system)) - val = XCONS (Vdefault_process_coding_system)->cdr; - else - val = Qnil; - } - XPROCESS (proc)->encode_coding_system = val; - } + val = Vcoding_system_for_read; + if (NILP (val)) + { + args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2); + args2[0] = Qstart_process; + for (i = 0; i < nargs; i++) args2[i + 1] = args[i]; + GCPRO1 (proc); + coding_systems = Ffind_operation_coding_system (nargs + 1, args2); + UNGCPRO; + if (CONSP (coding_systems)) + val = XCONS (coding_systems)->car; + else if (CONSP (Vdefault_process_coding_system)) + val = XCONS (Vdefault_process_coding_system)->car; + } + XPROCESS (proc)->decode_coding_system = val; + + val = Vcoding_system_for_write; + if (NILP (val)) + { + if (EQ (coding_systems, Qt)) + { + args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof args2); + args2[0] = Qstart_process; + for (i = 0; i < nargs; i++) args2[i + 1] = args[i]; + GCPRO1 (proc); + coding_systems = Ffind_operation_coding_system (nargs + 1, args2); + UNGCPRO; + } + if (CONSP (coding_systems)) + val = XCONS (coding_systems)->cdr; + else if (CONSP (Vdefault_process_coding_system)) + val = XCONS (Vdefault_process_coding_system)->cdr; + } + XPROCESS (proc)->encode_coding_system = val; + } XPROCESS (proc)->decoding_buf = make_uninit_string (0); + XPROCESS (proc)->decoding_carryover = make_number (0); XPROCESS (proc)->encoding_buf = make_uninit_string (0); + XPROCESS (proc)->encoding_carryover = make_number (0); + + XPROCESS (proc)->inherit_coding_system_flag + = (NILP (buffer) || !inherit_process_coding_system + ? Qnil : Qt); create_process (proc, (char **) new_argv, current_dir); @@ -1307,6 +1341,7 @@ create_process (process, new_argv, current_dir) volatile int forkin, forkout; volatile int pty_flag = 0; extern char **environ; + Lisp_Object buffer = XPROCESS (process)->buffer; inchannel = outchannel = -1; @@ -1396,11 +1431,25 @@ create_process (process, new_argv, current_dir) setup_coding_system (XPROCESS (process)->decode_coding_system, proc_decode_coding_system[inchannel]); if (!proc_encode_coding_system[outchannel]) - proc_encode_coding_system[outchannel] - = (struct coding_system *) xmalloc (sizeof (struct coding_system)); + proc_encode_coding_system[outchannel] + = (struct coding_system *) xmalloc (sizeof (struct coding_system)); setup_coding_system (XPROCESS (process)->encode_coding_system, proc_encode_coding_system[outchannel]); + if (!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters) + || (NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters))) + { + /* In unibyte mode, character code conversion should not take + place but EOL conversion should. So, setup raw-text or one + of the subsidiary according to the information just setup. */ + if (NILP (Vcoding_system_for_read) + && !NILP (XPROCESS (process)->decode_coding_system)) + setup_raw_text_coding_system (proc_decode_coding_system[inchannel]); + if (NILP (Vcoding_system_for_write) + && !NILP (XPROCESS (process)->encode_coding_system)) + setup_raw_text_coding_system (proc_encode_coding_system[outchannel]); + } + if (CODING_REQUIRE_ENCODING (proc_encode_coding_system[outchannel])) { /* Here we encode arguments by the coding system used for @@ -1411,23 +1460,22 @@ create_process (process, new_argv, current_dir) int i = 1; struct coding_system *coding = proc_encode_coding_system[outchannel]; - coding->last_block = 1; + coding->mode |= CODING_MODE_LAST_BLOCK; GCPRO1 (process); while (new_argv[i] != 0) { int len = strlen (new_argv[i]); int size = encoding_buffer_size (coding, len); unsigned char *buf = (unsigned char *) alloca (size); - int produced, dmy; - produced = encode_coding (coding, new_argv[i], buf, len, size, &dmy); - buf[produced] = 0; + encode_coding (coding, (unsigned char *)new_argv[i], buf, len, size); + buf[coding->produced] = 0; /* We don't have to free new_argv[i] because it points to a Lisp string given as an argument to `start-process'. */ - new_argv[i++] = buf; + new_argv[i++] = (char *) buf; } UNGCPRO; - coding->last_block = 0; + coding->mode &= ~CODING_MODE_LAST_BLOCK; } /* Delay interrupts until we have a chance to store @@ -1486,8 +1534,7 @@ create_process (process, new_argv, current_dir) Protect it from permanent change. */ char **save_environ = environ; - current_dir - = Fencode_coding_string (current_dir, Vfile_name_coding_system, Qt); + current_dir = ENCODE_FILE (current_dir); #ifndef WINDOWSNT pid = vfork (); @@ -1941,67 +1988,61 @@ Fourth arg SERVICE is name of the service desired, or an integer\n\ if (inch > max_process_desc) max_process_desc = inch; - if (!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters) - || NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters)) - { - XPROCESS (proc)->decode_coding_system = Qnil; - XPROCESS (proc)->encode_coding_system = Qnil; - } - else - { - /* Setup coding systems for communicating with the network stream. */ - struct gcpro gcpro1; - /* Qt denotes we have not yet called Ffind_operation_coding_system. */ - Lisp_Object coding_systems = Qt; - Lisp_Object args[5], val; - - if (!NILP (Vcoding_system_for_read)) - val = Vcoding_system_for_read; - else if (NILP (current_buffer->enable_multibyte_characters)) - /* We dare not decode end-of-line format by setting VAL to - Qemacs_mule, because the existing Emacs Lisp libraries - assume that they receive bare code including a sequene of - CR LF. */ - val = Qnil; - else - { - args[0] = Qopen_network_stream, args[1] = name, - args[2] = buffer, args[3] = host, args[4] = service; - GCPRO1 (proc); - coding_systems = Ffind_operation_coding_system (5, args); - UNGCPRO; - if (CONSP (coding_systems)) - val = XCONS (coding_systems)->car; - else if (CONSP (Vdefault_process_coding_system)) - val = XCONS (Vdefault_process_coding_system)->car; - else - val = Qnil; - } - XPROCESS (proc)->decode_coding_system = val; + { + /* Setup coding systems for communicating with the network stream. */ + struct gcpro gcpro1; + /* Qt denotes we have not yet called Ffind_operation_coding_system. */ + Lisp_Object coding_systems = Qt; + Lisp_Object args[5], val; + + if (!NILP (Vcoding_system_for_read)) + val = Vcoding_system_for_read; + else if (!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters) + || NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters)) + /* We dare not decode end-of-line format by setting VAL to + Qraw_text, because the existing Emacs Lisp libraries + assume that they receive bare code including a sequene of + CR LF. */ + val = Qnil; + else + { + args[0] = Qopen_network_stream, args[1] = name, + args[2] = buffer, args[3] = host, args[4] = service; + GCPRO1 (proc); + coding_systems = Ffind_operation_coding_system (5, args); + UNGCPRO; + if (CONSP (coding_systems)) + val = XCONS (coding_systems)->car; + else if (CONSP (Vdefault_process_coding_system)) + val = XCONS (Vdefault_process_coding_system)->car; + else + val = Qnil; + } + XPROCESS (proc)->decode_coding_system = val; - if (!NILP (Vcoding_system_for_write)) - val = Vcoding_system_for_write; - else if (NILP (current_buffer->enable_multibyte_characters)) - val = Qnil; - else - { - if (EQ (coding_systems, Qt)) - { - args[0] = Qopen_network_stream, args[1] = name, - args[2] = buffer, args[3] = host, args[4] = service; - GCPRO1 (proc); - coding_systems = Ffind_operation_coding_system (5, args); - UNGCPRO; - } - if (CONSP (coding_systems)) - val = XCONS (coding_systems)->cdr; - else if (CONSP (Vdefault_process_coding_system)) - val = XCONS (Vdefault_process_coding_system)->cdr; - else - val = Qnil; - } - XPROCESS (proc)->encode_coding_system = val; - } + if (!NILP (Vcoding_system_for_write)) + val = Vcoding_system_for_write; + else if (NILP (current_buffer->enable_multibyte_characters)) + val = Qnil; + else + { + if (EQ (coding_systems, Qt)) + { + args[0] = Qopen_network_stream, args[1] = name, + args[2] = buffer, args[3] = host, args[4] = service; + GCPRO1 (proc); + coding_systems = Ffind_operation_coding_system (5, args); + UNGCPRO; + } + if (CONSP (coding_systems)) + val = XCONS (coding_systems)->cdr; + else if (CONSP (Vdefault_process_coding_system)) + val = XCONS (Vdefault_process_coding_system)->cdr; + else + val = Qnil; + } + XPROCESS (proc)->encode_coding_system = val; + } if (!proc_decode_coding_system[inch]) proc_decode_coding_system[inch] @@ -2015,7 +2056,13 @@ Fourth arg SERVICE is name of the service desired, or an integer\n\ proc_encode_coding_system[outch]); XPROCESS (proc)->decoding_buf = make_uninit_string (0); + XPROCESS (proc)->decoding_carryover = make_number (0); XPROCESS (proc)->encoding_buf = make_uninit_string (0); + XPROCESS (proc)->encoding_carryover = make_number (0); + + XPROCESS (proc)->inherit_coding_system_flag + = (NILP (buffer) || !inherit_process_coding_system + ? Qnil : Qt); UNGCPRO; return proc; @@ -2171,7 +2218,7 @@ Return non-nil iff we received any output before the timeout expired.") static int waiting_for_user_input_p; /* This is here so breakpoints can be put on it. */ -static +static void wait_reading_process_input_1 () { } @@ -2208,6 +2255,7 @@ wait_reading_process_input_1 () before the timeout elapsed. Otherwise, return true iff we received input from any process. */ +int wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) int time_limit, microsecs; Lisp_Object read_kbd; @@ -2628,9 +2676,13 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) Therefore, if we get an error reading and errno = EIO, just continue, because the child process has exited and should clean itself up soon (e.g. when we - get a SIGCHLD). */ + get a SIGCHLD). + + However, it has been known to happen that the SIGCHLD + got lost. So raise the signl again just in case. + It can't hurt. */ else if (nread == -1 && errno == EIO) - ; + kill (getpid (), SIGCHLD); #endif /* HAVE_PTYS */ /* If we can detect process termination, don't consider the process gone just because its pipe is closed. */ @@ -2706,6 +2758,7 @@ read_process_output_error_handler (error) The characters read are decoded according to PROC's coding-system for decoding. */ +int read_process_output (proc, channel) Lisp_Object proc; register int channel; @@ -2724,7 +2777,7 @@ read_process_output (proc, channel) struct coding_system *coding = proc_decode_coding_system[channel]; int chars_in_decoding_buf = 0; /* If 1, `chars' points XSTRING (p->decoding_buf)->data. */ - int multibyte; + int carryover = XINT (p->decoding_carryover); #ifdef VMS VMS_PROC_STUFF *vs, *get_vms_process_pointer(); @@ -2746,33 +2799,36 @@ read_process_output (proc, channel) start_vms_process_read (vs); /* Crank up the next read on the process */ return 1; /* Nothing worth printing, say we got 1 */ } - if (coding->carryover_size) + if (carryover > 0) { - /* The data carried over in the previous decoding should be - prepended to the new data read to decode all together. */ - char *buf = (char *) xmalloc (nbytes + coding->carryover_size); - - bcopy (coding->carryover, buf, coding->carryover_size); - bcopy (chars, buf + coding->carryover_size, nbytes); + /* The data carried over in the previous decoding (which are at + the tail of decoding buffer) should be prepended to the new + data read to decode all together. */ + char *buf = (char *) xmalloc (nbytes + carryover); + + bcopy (XSTRING (p->decoding_buf)->data + + STRING_BYTES (XSTRING (p->decoding_buf)) - carryover, + buf, carryover); + bcopy (chars, buf + carryover, nbytes); chars = buf; chars_allocated = 1; } #else /* not VMS */ - if (coding->carryover_size) - /* The data carried over in the previous decoding should be - prepended to the new data read to decode all together. */ - bcopy (coding->carryover, buf, coding->carryover_size); + if (carryover) + /* See the comment above. */ + bcopy (XSTRING (p->decoding_buf)->data + + STRING_BYTES (XSTRING (p->decoding_buf)) - carryover, + buf, carryover); if (proc_buffered_char[channel] < 0) - nbytes = read (channel, buf + coding->carryover_size, - (sizeof buf) - coding->carryover_size); + nbytes = read (channel, buf + carryover, (sizeof buf) - carryover); else { - buf[coding->carryover_size] = proc_buffered_char[channel]; + buf[carryover] = proc_buffered_char[channel]; proc_buffered_char[channel] = -1; - nbytes = read (channel, buf + coding->carryover_size + 1, - (sizeof buf) - coding->carryover_size - 1); + nbytes = read (channel, buf + carryover + 1, + (sizeof buf) - carryover - 1); if (nbytes < 0) nbytes = 1; else @@ -2781,26 +2837,51 @@ read_process_output (proc, channel) chars = buf; #endif /* not VMS */ + XSETINT (p->decoding_carryover, 0); + /* At this point, NBYTES holds number of characters just received (including the one in proc_buffered_char[channel]). */ - if (nbytes <= 0) return nbytes; + if (nbytes <= 0) + { + if (nbytes < 0 || coding->mode & CODING_MODE_LAST_BLOCK) + return nbytes; + coding->mode |= CODING_MODE_LAST_BLOCK; + } /* Now set NBYTES how many bytes we must decode. */ - nbytes += coding->carryover_size; + nbytes += carryover; + nchars = nbytes; - if (CODING_REQUIRE_DECODING (coding) - || CODING_REQUIRE_DETECTION (coding)) + if (CODING_MAY_REQUIRE_DECODING (coding)) { int require = decoding_buffer_size (coding, nbytes); - int consumed, produced; + int result; - if (XSTRING (p->decoding_buf)->size_byte < require) + if (STRING_BYTES (XSTRING (p->decoding_buf)) < require) p->decoding_buf = make_uninit_string (require); - produced = decode_coding (coding, chars, XSTRING (p->decoding_buf)->data, - nbytes, XSTRING (p->decoding_buf)->size_byte, - &consumed); + result = decode_coding (coding, chars, XSTRING (p->decoding_buf)->data, + nbytes, STRING_BYTES (XSTRING (p->decoding_buf))); + carryover = nbytes - coding->consumed; + if (carryover > 0) + { + /* Copy the carryover bytes to the end of p->decoding_buf, to + be processed on the next read. Since decoding_buffer_size + asks for an extra amount of space beyond the maximum + expected for the output, there should always be sufficient + space for the carryover (which is by definition a sequence + of bytes that was not long enough to be decoded, and thus + has a bounded length). */ + if (STRING_BYTES (XSTRING (p->decoding_buf)) + < coding->produced + carryover) + abort (); + bcopy (chars + coding->consumed, + XSTRING (p->decoding_buf)->data + + STRING_BYTES (XSTRING (p->decoding_buf)) - carryover, + carryover); + XSETINT (p->decoding_carryover, carryover); + } - /* New coding-system might be found by `decode_coding'. */ + /* A new coding system might be found by `decode_coding'. */ if (!EQ (p->decode_coding_system, coding->symbol)) { p->decode_coding_system = coding->symbol; @@ -2809,7 +2890,7 @@ read_process_output (proc, channel) proc_decode_coding_system[channel] here. It is done in detect_coding called via decode_coding above. */ - /* If coding-system for encoding is not yet decided, we set + /* If a coding system for encoding is not yet decided, we set it as the same as coding-system for decoding. But, before doing that we must check if @@ -2817,11 +2898,11 @@ read_process_output (proc, channel) valid memory because p->outfd will be changed once EOF is sent to the process. */ if (NILP (p->encode_coding_system) - && proc_encode_coding_system[p->outfd]) + && proc_encode_coding_system[XINT (p->outfd)]) { p->encode_coding_system = coding->symbol; setup_coding_system (coding->symbol, - proc_encode_coding_system[p->outfd]); + proc_encode_coding_system[XINT (p->outfd)]); } } @@ -2830,40 +2911,50 @@ read_process_output (proc, channel) if (chars_allocated) free (chars); #endif - if (produced == 0) + if (coding->produced == 0) return 0; chars = (char *) XSTRING (p->decoding_buf)->data; - nbytes = produced; + nbytes = coding->produced; + nchars = (coding->fake_multibyte + ? multibyte_chars_in_text (chars, nbytes) + : coding->produced_char); chars_in_decoding_buf = 1; } -#ifdef VMS - else if (chars_allocated) + else { - /* Although we don't have to decode the received data, we must - move it to an area which we don't have to free. */ - if (! STRINGP (p->decoding_buf) - || XSTRING (p->decoding_buf)->size < nbytes) - p->decoding_buf = make_uninit_string (nbytes); - bcopy (chars, XSTRING (p->decoding_buf)->data, nbytes); - free (chars); - chars = XSTRING (p->decoding_buf)->data; - chars_in_decoding_buf = 1; - } +#ifdef VMS + if (chars_allocated) + { + /* Although we don't have to decode the received data, we + must move it to an area which we don't have to free. */ + if (! STRINGP (p->decoding_buf) + || STRING_BYTES (XSTRING (p->decoding_buf)) < nbytes) + p->decoding_buf = make_uninit_string (nbytes); + bcopy (chars, XSTRING (p->decoding_buf)->data, nbytes); + free (chars); + chars = XSTRING (p->decoding_buf)->data; + chars_in_decoding_buf = 1; + } #endif + nchars = multibyte_chars_in_text (chars, nbytes); + } Vlast_coding_system_used = coding->symbol; - multibyte = (coding->type != coding_type_emacs_mule - && coding->type != coding_type_no_conversion - && coding->type != coding_type_undecided - && coding->type != coding_type_raw_text); + /* If the caller required, let the process associated buffer + inherit the coding-system used to decode the process output. */ + if (! NILP (p->inherit_coding_system_flag) + && !NILP (p->buffer) && !NILP (XBUFFER (p->buffer)->name)) + { + struct buffer *prev_buf = current_buffer; - /* Read and dispose of the process output. */ - if (multibyte) - nchars = multibyte_chars_in_text (chars, nbytes); - else - nchars = nbytes; + Fset_buffer (p->buffer); + call1 (intern ("after-insert-file-set-buffer-file-coding-system"), + make_number (nbytes)); + set_buffer_internal (prev_buf); + } + /* Read and dispose of the process output. */ outstream = p->filter; if (!NILP (outstream)) { @@ -2875,6 +2966,7 @@ read_process_output (proc, channel) Lisp_Object obuffer, okeymap; Lisp_Object text; int outer_running_asynch_code = running_asynch_code; + int waiting = waiting_for_user_input_p; /* No need to gcpro these, because all we do with them later is test them for EQness, and none of them should be a string. */ @@ -2894,15 +2986,22 @@ read_process_output (proc, channel) /* Don't clobber the CURRENT match data, either! */ tem = Fmatch_data (Qnil, Qnil); restore_match_data (); - record_unwind_protect (Fstore_match_data, Fmatch_data (Qnil, Qnil)); - Fstore_match_data (tem); + record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil)); + Fset_match_data (tem); } /* For speed, if a search happens within this code, save the match data in a special nonrecursive fashion. */ running_asynch_code = 1; - text = make_multibyte_string (chars, nchars, nbytes); + /* The multibyteness of a string given to the filter is decided + by which coding system we used for decoding. */ + if (coding->type == coding_type_no_conversion + || coding->type == coding_type_raw_text) + text = make_unibyte_string (chars, nbytes); + else + text = make_multibyte_string (chars, nchars, nbytes); + internal_condition_case_1 (read_process_output_call, Fcons (outstream, Fcons (proc, Fcons (text, Qnil))), @@ -2916,6 +3015,10 @@ read_process_output (proc, channel) /* Handling the process output should not deactivate the mark. */ Vdeactivate_mark = odeactivate; + /* Restore waiting_for_user_input_p as it was + when we were called, in case the filter clobbered it. */ + waiting_for_user_input_p = waiting; + #if 0 /* Call record_asynch_buffer_change unconditionally, because we might have changed minor modes or other things that affect key bindings. */ @@ -2975,13 +3078,26 @@ read_process_output (proc, channel) if (! (BEGV <= PT && PT <= ZV)) Fwiden (); + if (NILP (current_buffer->enable_multibyte_characters)) + nchars = nbytes; + /* Insert before markers in case we are inserting where the buffer's mark is, and the user's next command is Meta-y. */ if (chars_in_decoding_buf) - insert_from_string_before_markers (p->decoding_buf, 0, 0, - nchars, nbytes, 0); + { + /* Since multibyteness of p->docoding_buf is corrupted, we + can't use insert_from_string_before_markers. */ + char *temp_buf; + + temp_buf = (char *) alloca (nbytes); + bcopy (XSTRING (p->decoding_buf)->data, temp_buf, nbytes); + insert_before_markers (temp_buf, nbytes); + } else - insert_1_both (chars, nchars, nbytes, 0, 1, 1); + { + insert_1_both (chars, nchars, nbytes, 0, 1, 1); + signal_after_change (opoint, 0, PT - opoint); + } set_marker_both (p->mark, p->buffer, PT, PT_BYTE); update_mode_lines++; @@ -3054,6 +3170,7 @@ send_process_trap () being encoded. Should we store them in a buffer to prepend them to the data send later? */ +void send_process (proc, buf, len, object) volatile Lisp_Object proc; unsigned char *buf; @@ -3065,6 +3182,7 @@ send_process (proc, buf, len, object) volatile unsigned char *procname = XSTRING (XPROCESS (proc)->name)->data; struct coding_system *coding; struct gcpro gcpro1; + int carryover = XINT (XPROCESS (proc)->encoding_carryover); GCPRO1 (object); @@ -3098,9 +3216,9 @@ send_process (proc, buf, len, object) ? offset = buf - XSTRING (object)->data : -1)); - if (coding->carryover_size > 0) + if (carryover > 0) { - temp_buf = (unsigned char *) xmalloc (len + coding->carryover_size); + temp_buf = (unsigned char *) xmalloc (len + carryover); if (offset >= 0) { @@ -3111,12 +3229,16 @@ send_process (proc, buf, len, object) /* Now we don't have to care relocation. */ offset = -1; } - bcopy (coding->carryover, temp_buf, coding->carryover_size); - bcopy (buf, temp_buf + coding->carryover_size, len); + bcopy ((XSTRING (XPROCESS (proc)->encoding_buf)->data + + STRING_BYTES (XSTRING (XPROCESS (proc)->encoding_buf)) + - carryover), + temp_buf, + carryover); + bcopy (buf, temp_buf + carryover, len); buf = temp_buf; } - if (XSTRING (XPROCESS (proc)->encoding_buf)->size_byte < require) + if (STRING_BYTES (XSTRING (XPROCESS (proc)->encoding_buf)) < require) { XPROCESS (proc)->encoding_buf = make_uninit_string (require); @@ -3129,8 +3251,9 @@ send_process (proc, buf, len, object) } } object = XPROCESS (proc)->encoding_buf; - len = encode_coding (coding, buf, XSTRING (object)->data, - len, XSTRING (object)->size_byte, &dummy); + encode_coding (coding, buf, XSTRING (object)->data, + len, STRING_BYTES (XSTRING (object))); + len = coding->produced; buf = XSTRING (object)->data; if (temp_buf) xfree (temp_buf); @@ -3314,7 +3437,7 @@ Output from processes can arrive in between bunches.") CHECK_STRING (string, 1); proc = get_process (process); send_process (proc, XSTRING (string)->data, - XSTRING (string)->size_byte, string); + STRING_BYTES (XSTRING (string)), string); return Qnil; } @@ -3536,7 +3659,7 @@ process_send_signal (process, signo, current_group, nomsg) } DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0, - "Interrupt process PROCESS. May be process or name of one.\n\ + "Interrupt process PROCESS.\n\ PROCESS may be a process, a buffer, or the name of a process or buffer.\n\ nil or no arg means current buffer's process.\n\ Second arg CURRENT-GROUP non-nil means send signal to\n\ @@ -3725,7 +3848,7 @@ SIGCODE may be an integer, or a symbol whose name is a signal name.") DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0, "Make PROCESS see end-of-file in its input.\n\ -Eof comes after any text already sent to it.\n\ +EOF comes after any text already sent to it.\n\ PROCESS may be a process, a buffer, the name of a process or buffer, or\n\ nil, indicating the current buffer's process.\n\ If PROCESS is a network connection, or is a process communicating\n\ @@ -3735,8 +3858,10 @@ text to PROCESS after you call this function.") Lisp_Object process; { Lisp_Object proc; + struct coding_system *coding; proc = get_process (process); + coding = proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)]; /* Make sure the process is really alive. */ if (! NILP (XPROCESS (proc)->raw_status_low)) @@ -3744,6 +3869,12 @@ text to PROCESS after you call this function.") if (! EQ (XPROCESS (proc)->status, Qrun)) error ("Process %s not running", XSTRING (XPROCESS (proc)->name)->data); + if (CODING_REQUIRE_FLUSHING (coding)) + { + coding->mode |= CODING_MODE_LAST_BLOCK; + send_process (proc, "", 0, Qnil); + } + #ifdef VMS send_process (proc, "\032", 1, Qnil); /* ^z */ #else @@ -3751,6 +3882,8 @@ text to PROCESS after you call this function.") send_process (proc, "\004", 1, Qnil); else { + int old_outfd, new_outfd; + #ifdef HAVE_SHUTDOWN /* If this is a network connection, or socketpair is used for communication with the subprocess, call shutdown to cause EOF. @@ -3765,7 +3898,19 @@ text to PROCESS after you call this function.") #else /* not HAVE_SHUTDOWN */ close (XINT (XPROCESS (proc)->outfd)); #endif /* not HAVE_SHUTDOWN */ - XSETINT (XPROCESS (proc)->outfd, open (NULL_DEVICE, O_WRONLY)); + new_outfd = open (NULL_DEVICE, O_WRONLY); + old_outfd = XINT (XPROCESS (proc)->outfd); + + if (!proc_encode_coding_system[new_outfd]) + proc_encode_coding_system[new_outfd] + = (struct coding_system *) xmalloc (sizeof (struct coding_system)); + bcopy (proc_encode_coding_system[old_outfd], + proc_encode_coding_system[new_outfd], + sizeof (struct coding_system)); + bzero (proc_encode_coding_system[old_outfd], + sizeof (struct coding_system)); + + XSETINT (XPROCESS (proc)->outfd, new_outfd); } #endif /* VMS */ return process; @@ -3997,6 +4142,7 @@ exec_sentinel (proc, reason) register struct Lisp_Process *p = XPROCESS (proc); int count = specpdl_ptr - specpdl; int outer_running_asynch_code = running_asynch_code; + int waiting = waiting_for_user_input_p; /* No need to gcpro these, because all we do with them later is test them for EQness, and none of them should be a string. */ @@ -4024,8 +4170,8 @@ exec_sentinel (proc, reason) Lisp_Object tem; tem = Fmatch_data (Qnil, Qnil); restore_match_data (); - record_unwind_protect (Fstore_match_data, Fmatch_data (Qnil, Qnil)); - Fstore_match_data (tem); + record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil)); + Fset_match_data (tem); } /* For speed, if a search happens within this code, @@ -4043,6 +4189,11 @@ exec_sentinel (proc, reason) running_asynch_code = outer_running_asynch_code; Vdeactivate_mark = odeactivate; + + /* Restore waiting_for_user_input_p as it was + when we were called, in case the filter clobbered it. */ + waiting_for_user_input_p = waiting; + #if 0 if (! EQ (Fcurrent_buffer (), obuffer) || ! EQ (current_buffer->keymap, okeymap)) @@ -4184,8 +4335,9 @@ status_notify () DEFUN ("set-process-coding-system", Fset_process_coding_system, Sset_process_coding_system, 1, 3, 0, - "Set coding systems of PROCESS to DECODING (input from the process) and\n\ -ENCODING (output to the process).") + "Set coding systems of PROCESS to DECODING and ENCODING.\n\ +DECODING will be used to decode subprocess output and ENCODING to\n\ +encode subprocess input.") (proc, decoding, encoding) register Lisp_Object proc, decoding, encoding; { @@ -4275,6 +4427,7 @@ keyboard_bit_set (mask) return 0; } +void init_process () { register int i; @@ -4301,8 +4454,14 @@ init_process () } bzero (proc_decode_coding_system, sizeof proc_decode_coding_system); bzero (proc_encode_coding_system, sizeof proc_encode_coding_system); + + Vdefault_process_coding_system + = (NILP (buffer_defaults.enable_multibyte_characters) + ? Fcons (Qraw_text, Qnil) + : Fcons (Qemacs_mule, Qnil)); } +void syms_of_process () { Qprocessp = intern ("processp"); @@ -4362,6 +4521,8 @@ The value takes effect when `start-process' is called."); defsubr (&Sset_process_sentinel); defsubr (&Sprocess_sentinel); defsubr (&Sset_process_window_size); + defsubr (&Sset_process_inherit_coding_system_flag); + defsubr (&Sprocess_inherit_coding_system_flag); defsubr (&Sprocess_kill_without_query); defsubr (&Sprocess_contact); defsubr (&Slist_processes); @@ -4394,6 +4555,8 @@ The value takes effect when `start-process' is called."); #include "lisp.h" #include "systime.h" +#include "charset.h" +#include "coding.h" #include "termopts.h" #include "sysselect.h" @@ -4432,6 +4595,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) Lisp_Object read_kbd; int do_display; { + register int nfds; EMACS_TIME end_time, timeout; SELECT_TYPE waitchannels; int xerrno; @@ -4447,27 +4611,17 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) /* What does time_limit really mean? */ if (time_limit || microsecs) { - if (time_limit == -1) - /* In fact, it's zero. */ - EMACS_SET_SECS_USECS (timeout, 0, 0); - else - EMACS_SET_SECS_USECS (timeout, time_limit, microsecs); - - /* How far in the future is that? */ EMACS_GET_TIME (end_time); + EMACS_SET_SECS_USECS (timeout, time_limit, microsecs); EMACS_ADD_TIME (end_time, end_time, timeout); } - else - /* It's infinite. */ - EMACS_SET_SECS_USECS (timeout, 100000, 0); /* Turn off periodic alarms (in case they are in use) because the select emulator uses alarms. */ stop_polling (); - for (;;) + while (1) { - int nfds; int timeout_reduced_for_timers = 0; /* If calling from keyboard input, do not quit @@ -4482,13 +4636,25 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) /* Compute time from now till when time limit is up */ /* Exit if already run out */ - if (time_limit > 0 || microsecs) + if (time_limit == -1) + { + /* -1 specified for timeout means + gobble output available now + but don't wait at all. */ + + EMACS_SET_SECS_USECS (timeout, 0, 0); + } + else if (time_limit || microsecs) { EMACS_GET_TIME (timeout); EMACS_SUB_TIME (timeout, end_time, timeout); if (EMACS_TIME_NEG_P (timeout)) break; } + else + { + EMACS_SET_SECS_USECS (timeout, 100000, 0); + } /* If our caller will not immediately handle keyboard events, run timer events directly. @@ -4510,6 +4676,11 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) goto retry; } + /* If there is unread keyboard input, also return. */ + if (XINT (read_kbd) != 0 + && requeued_events_pending_p ()) + break; + if (! EMACS_TIME_NEG_P (timer_delay) && time_limit != -1) { EMACS_TIME difference; @@ -4594,6 +4765,11 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) break; } + /* If there is unread keyboard input, also return. */ + if (XINT (read_kbd) != 0 + && requeued_events_pending_p ()) + break; + /* If wait_for_cell. check for keyboard input but don't run any timers. ??? (It seems wrong to me to check for keyboard @@ -4629,22 +4805,40 @@ DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0, return Qnil; } +DEFUN ("process-inherit-coding-system-flag", + Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag, + 1, 1, 0, + /* Don't confuse make-docfile by having two doc strings for this function. + make-docfile does not pay attention to #if, for good reason! */ + 0) + (process) + register Lisp_Object process; +{ + /* Ignore the argument and return the value of + inherit-process-coding-system. */ + return inherit_process_coding_system ? Qt : Qnil; +} + /* Kill all processes associated with `buffer'. If `buffer' is nil, kill all processes. Since we have no subprocesses, this does nothing. */ +void kill_buffer_processes (buffer) Lisp_Object buffer; { } +void init_process () { } +void syms_of_process () { defsubr (&Sget_buffer_process); + defsubr (&Sprocess_inherit_coding_system_flag); }