Commit 0fa1789e authored by Karl Heuer's avatar Karl Heuer
Browse files

Include charset.h and coding.h.

(proc_decode_coding_system, proc_encode_coding_system): New
variables.
(Fstart_process, create_process, Fopen_network_stream): Setup
coding systems for character code conversion.
(READ_CHILD_OUTPUT): New macro.
(read_process_output): Perform character code conversion of a
process output.
(send_process): Perform character code conversion of a text sent
to a process.
(Fset_process_coding_system, Fprocess_coding_system): New
functions.
(syms_of_process): Handle them.
parent 087e3c46
...@@ -98,6 +98,8 @@ Boston, MA 02111-1307, USA. */ ...@@ -98,6 +98,8 @@ Boston, MA 02111-1307, USA. */
#include "lisp.h" #include "lisp.h"
#include "window.h" #include "window.h"
#include "buffer.h" #include "buffer.h"
#include "charset.h"
#include "coding.h"
#include "process.h" #include "process.h"
#include "termhooks.h" #include "termhooks.h"
#include "termopts.h" #include "termopts.h"
...@@ -246,6 +248,10 @@ Lisp_Object Vprocess_alist; ...@@ -246,6 +248,10 @@ Lisp_Object Vprocess_alist;
/* Don't make static; need to access externally. */ /* Don't make static; need to access externally. */
int proc_buffered_char[MAXDESC]; int proc_buffered_char[MAXDESC];
/* Table of `struct coding-system' for each process. */
static struct coding_system proc_decode_coding_system[MAXDESC];
static struct coding_system proc_encode_coding_system[MAXDESC];
static Lisp_Object get_process (); static Lisp_Object get_process ();
extern EMACS_TIME timer_check (); extern EMACS_TIME timer_check ();
...@@ -1018,7 +1024,7 @@ BUFFER is the buffer or (buffer-name) to associate with the process.\n\ ...@@ -1018,7 +1024,7 @@ BUFFER is the buffer or (buffer-name) to associate with the process.\n\
Process output goes at end of that buffer, unless you specify\n\ Process output goes at end of that buffer, unless you specify\n\
an output stream or filter function to handle the output.\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\ BUFFER may be also nil, meaning that this process is not associated\n\
with any buffer\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 as in the shell.\n\
Remaining arguments are strings to give program as arguments.") Remaining arguments are strings to give program as arguments.")
(nargs, args) (nargs, args)
...@@ -1148,6 +1154,46 @@ Remaining arguments are strings to give program as arguments.") ...@@ -1148,6 +1154,46 @@ Remaining arguments are strings to give program as arguments.")
Fset_marker (XPROCESS (proc)->mark, Fset_marker (XPROCESS (proc)->mark,
make_number (BUF_ZV (XBUFFER (buffer))), buffer); make_number (BUF_ZV (XBUFFER (buffer))), buffer);
/* Setup coding systems for communicating with the process. */
{
/* Qt denotes that we have not yet called Ffind_coding_system. */
Lisp_Object coding_systems = Qt;
Lisp_Object val, *args2;
struct gcpro gcpro1;
if (NILP (val = Vcoding_system_for_read))
{
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_coding_system (nargs + 1, args2);
UNGCPRO;
if (CONSP (coding_systems))
val = XCONS (coding_systems)->car;
}
XPROCESS (proc)->decode_coding_system = val;
if (NILP (val = Vcoding_system_for_write))
{
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_coding_system (nargs + 1, args2);
UNGCPRO;
}
if (CONSP (coding_systems))
val = XCONS (coding_systems)->cdr;
}
XPROCESS (proc)->encode_coding_system = val;
}
XPROCESS (proc)->decoding_buf = make_uninit_string (0);
XPROCESS (proc)->encoding_buf = make_uninit_string (0);
create_process (proc, new_argv, current_dir); create_process (proc, new_argv, current_dir);
return unbind_to (count, proc); return unbind_to (count, proc);
...@@ -1310,6 +1356,10 @@ create_process (process, new_argv, current_dir) ...@@ -1310,6 +1356,10 @@ create_process (process, new_argv, current_dir)
XSETFASTINT (XPROCESS (process)->subtty, forkin); XSETFASTINT (XPROCESS (process)->subtty, forkin);
XPROCESS (process)->pty_flag = (pty_flag ? Qt : Qnil); XPROCESS (process)->pty_flag = (pty_flag ? Qt : Qnil);
XPROCESS (process)->status = Qrun; XPROCESS (process)->status = Qrun;
setup_coding_system (XPROCESS (process)->decode_coding_system,
&proc_decode_coding_system[inchannel]);
setup_coding_system (XPROCESS (process)->encode_coding_system,
&proc_encode_coding_system[outchannel]);
/* Delay interrupts until we have a chance to store /* Delay interrupts until we have a chance to store
the new fork's pid in its process structure */ the new fork's pid in its process structure */
...@@ -1821,6 +1871,47 @@ Fourth arg SERVICE is name of the service desired, or an integer\n\ ...@@ -1821,6 +1871,47 @@ Fourth arg SERVICE is name of the service desired, or an integer\n\
if (inch > max_process_desc) if (inch > max_process_desc)
max_process_desc = inch; max_process_desc = inch;
/* Setup coding systems for communicating with the network stream. */
{
struct gcpro gcpro1;
/* Qt denotes that we have not yet called Ffind_coding_system. */
Lisp_Object coding_systems = Qt;
Lisp_Object args[5], val;
if (NILP (val = Vcoding_system_for_read))
{
args[0] = Qopen_network_stream, args[1] = name,
args[2] = buffer, args[3] = host, args[4] = service;
GCPRO1 (proc);
coding_systems = Ffind_coding_system (5, args);
UNGCPRO;
val = (CONSP (coding_systems) ? XCONS (coding_systems)->car : Qnil);
}
XPROCESS (proc)->decode_coding_system = val;
if (NILP (val = Vcoding_system_for_write))
{
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_coding_system (5, args);
UNGCPRO;
}
val = (CONSP (coding_systems) ? XCONS (coding_systems)->cdr : Qnil);
}
XPROCESS (proc)->encode_coding_system = val;
}
setup_coding_system (XPROCESS (proc)->decode_coding_system,
&proc_decode_coding_system[inch]);
setup_coding_system (XPROCESS (proc)->encode_coding_system,
&proc_encode_coding_system[outch]);
XPROCESS (proc)->decoding_buf = make_uninit_string (0);
XPROCESS (proc)->encoding_buf = make_uninit_string (0);
UNGCPRO; UNGCPRO;
return proc; return proc;
} }
...@@ -2447,28 +2538,41 @@ read_process_output_error_handler (error) ...@@ -2447,28 +2538,41 @@ read_process_output_error_handler (error)
Fsleep_for (make_number (2), Qnil); Fsleep_for (make_number (2), Qnil);
} }
#ifdef WINDOWSNT
#define READ_CHILD_OUTPUT read_child_output
#else
#define READ_CHILD_OUTPUT read
#endif
/* Read pending output from the process channel, /* Read pending output from the process channel,
starting with our buffered-ahead character if we have one. starting with our buffered-ahead character if we have one.
Yield number of characters read. Yield number of decoded characters read.
This function reads at most 1024 characters. This function reads at most 1024 characters.
If you want to read all available subprocess output, If you want to read all available subprocess output,
you must call it repeatedly until it returns zero. */ you must call it repeatedly until it returns zero.
The characters read are decoded according to PROC's coding-system
for decoding. */
read_process_output (proc, channel) read_process_output (proc, channel)
Lisp_Object proc; Lisp_Object proc;
register int channel; register int channel;
{ {
register int nchars; register int nchars;
#ifdef VMS
char *chars; char *chars;
#ifdef VMS
int chars_allocated = 0; /* If 1, `chars' should be freed later. */
#else #else
char chars[1024]; char buf[1024];
#endif #endif
register Lisp_Object outstream; register Lisp_Object outstream;
register struct buffer *old = current_buffer; register struct buffer *old = current_buffer;
register struct Lisp_Process *p = XPROCESS (proc); register struct Lisp_Process *p = XPROCESS (proc);
register int opoint; register int opoint;
struct coding_system *coding = &proc_decode_coding_system[channel];
int chars_in_decoding_buf = 0; /* If 1, `chars' points
XSTRING (p->decoding_buf)->data. */
#ifdef VMS #ifdef VMS
VMS_PROC_STUFF *vs, *get_vms_process_pointer(); VMS_PROC_STUFF *vs, *get_vms_process_pointer();
...@@ -2490,24 +2594,100 @@ read_process_output (proc, channel) ...@@ -2490,24 +2594,100 @@ read_process_output (proc, channel)
start_vms_process_read (vs); /* Crank up the next read on the process */ start_vms_process_read (vs); /* Crank up the next read on the process */
return 1; /* Nothing worth printing, say we got 1 */ return 1; /* Nothing worth printing, say we got 1 */
} }
if (coding->carryover_size)
{
/* The data carried over in the previous decoding should be
prepended to the new data read to decode all together. */
char *buf = (char *) xmalloc (nchars + coding->carryover_size);
bcopy (coding->carryover, buf, coding->carryover_size);
bcopy (chars, buf + coding->carryover_size, nchars);
chars = buf;
chars_allocated = 1;
}
#else /* not VMS */ #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 (proc_buffered_char[channel] < 0) if (proc_buffered_char[channel] < 0)
nchars = read (channel, chars, sizeof (chars)); nchars = READ_CHILD_OUTPUT (channel, buf + coding->carryover_size,
(sizeof buf) - coding->carryover_size);
else else
{ {
chars[0] = proc_buffered_char[channel]; buf[coding->carryover_size] = proc_buffered_char[channel];
proc_buffered_char[channel] = -1; proc_buffered_char[channel] = -1;
nchars = read (channel, chars + 1, sizeof (chars) - 1); nchars = READ_CHILD_OUTPUT (channel, buf + coding->carryover_size + 1,
(sizeof buf) - coding->carryover_size - 1);
if (nchars < 0) if (nchars < 0)
nchars = 1; nchars = 1;
else else
nchars = nchars + 1; nchars = nchars + 1;
} }
chars = buf;
#endif /* not VMS */ #endif /* not VMS */
/* At this point, NCHARS holds number of characters just received
(including the one in proc_buffered_char[channel]). */
if (nchars <= 0) return nchars; if (nchars <= 0) return nchars;
/* Now set NCHARS how many bytes we must decode. */
nchars += coding->carryover_size;
if (CODING_REQUIRE_CONVERSION (coding))
{
int require = decoding_buffer_size (coding, nchars);
int consumed, produced;
if (XSTRING (p->decoding_buf)->size < require)
p->decoding_buf = make_uninit_string (require);
produced = decode_coding (coding, chars, XSTRING (p->decoding_buf)->data,
nchars, XSTRING (p->decoding_buf)->size,
&consumed);
/* New coding-system might be found by `decode_coding'. */
if (!EQ (p->decode_coding_system, coding->symbol))
{
p->decode_coding_system = coding->symbol;
setup_coding_system (coding->symbol,
&proc_decode_coding_system[channel]);
/* If coding-system for encoding is not yet decided, we set it
as the same as coding-system for decoding. */
if (NILP (p->encode_coding_system))
{
p->encode_coding_system = coding->symbol;
setup_coding_system (coding->symbol,
&proc_encode_coding_system[channel]);
}
}
#ifdef VMS
/* Now we don't need the contents of `chars'. */
if (chars_allocated)
free (chars);
#endif
if (produced == 0)
return 0;
chars = XSTRING (p->decoding_buf)->data;
nchars = produced;
chars_in_decoding_buf = 1;
}
#ifdef VMS
else 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)
|| XSTRING (p->decoding_buf)->size < nchars)
p->decoding_buf = make_uninit_string (nchars);
bcopy (chars, XSTRING (p->decoding_buf)->data, nchars);
free (chars);
chars = XSTRING (p->decoding_buf)->data;
chars_in_decoding_buf = 1;
}
#endif
outstream = p->filter; outstream = p->filter;
if (!NILP (outstream)) if (!NILP (outstream))
{ {
...@@ -2624,7 +2804,10 @@ read_process_output (proc, channel) ...@@ -2624,7 +2804,10 @@ read_process_output (proc, channel)
/* Insert before markers in case we are inserting where /* Insert before markers in case we are inserting where
the buffer's mark is, and the user's next command is Meta-y. */ the buffer's mark is, and the user's next command is Meta-y. */
insert_before_markers (chars, nchars); if (chars_in_decoding_buf)
insert_from_string_before_markers (p->decoding_buf, 0, nchars, 0);
else
insert_before_markers (chars, nchars);
Fset_marker (p->mark, make_number (PT), p->buffer); Fset_marker (p->mark, make_number (PT), p->buffer);
update_mode_lines++; update_mode_lines++;
...@@ -2671,7 +2854,13 @@ send_process_trap () ...@@ -2671,7 +2854,13 @@ send_process_trap ()
/* Send some data to process PROC. /* Send some data to process PROC.
BUF is the beginning of the data; LEN is the number of characters. BUF is the beginning of the data; LEN is the number of characters.
OBJECT is the Lisp object that the data comes from. */ OBJECT is the Lisp object that the data comes from.
The data is encoded by PROC's coding-system for encoding before it
is sent. But if the data ends at the middle of multi-byte
representation, that incomplete sequence of bytes are sent without
being encoded. Should we store them in a buffer to prepend them to
the data send later? */
send_process (proc, buf, len, object) send_process (proc, buf, len, object)
volatile Lisp_Object proc; volatile Lisp_Object proc;
...@@ -2682,6 +2871,7 @@ send_process (proc, buf, len, object) ...@@ -2682,6 +2871,7 @@ send_process (proc, buf, len, object)
/* Use volatile to protect variables from being clobbered by longjmp. */ /* Use volatile to protect variables from being clobbered by longjmp. */
int rv; int rv;
volatile unsigned char *procname = XSTRING (XPROCESS (proc)->name)->data; volatile unsigned char *procname = XSTRING (XPROCESS (proc)->name)->data;
struct coding_system *coding;
struct gcpro gcpro1; struct gcpro gcpro1;
GCPRO1 (object); GCPRO1 (object);
...@@ -2695,6 +2885,62 @@ send_process (proc, buf, len, object) ...@@ -2695,6 +2885,62 @@ send_process (proc, buf, len, object)
update_status (XPROCESS (proc)); update_status (XPROCESS (proc));
if (! EQ (XPROCESS (proc)->status, Qrun)) if (! EQ (XPROCESS (proc)->status, Qrun))
error ("Process %s not running", procname); error ("Process %s not running", procname);
if (XINT (XPROCESS (proc)->outfd) < 0)
error ("Output file descriptor of %s is closed", procname);
coding = &proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)];
if (CODING_REQUIRE_CONVERSION (coding))
{
int require = encoding_buffer_size (coding, len);
int offset, dummy;
char *temp_buf = NULL;
/* Remember the offset of data because a string or a buffer may
be relocated. Setting OFFSET to -1 means we don't have to
care relocation. */
offset = (BUFFERP (object)
? BUF_PTR_CHAR_POS (XBUFFER (object), (unsigned char *) buf)
: (STRINGP (object)
? offset = buf - (char *) XSTRING (object)->data
: -1));
if (coding->carryover_size > 0)
{
temp_buf = (char *) xmalloc (len + coding->carryover_size);
if (offset >= 0)
{
if (BUFFERP (object))
buf = (char *) BUF_CHAR_ADDRESS (XBUFFER (object), offset);
else if (STRINGP (object))
buf = offset + (char *) XSTRING (object)->data;
/* 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);
buf = temp_buf;
}
if (XSTRING (XPROCESS (proc)->encoding_buf)->size < require)
{
XPROCESS (proc)->encoding_buf = make_uninit_string (require);
if (offset >= 0)
{
if (BUFFERP (object))
buf = (char *) BUF_CHAR_ADDRESS (XBUFFER (object), offset);
else if (STRINGP (object))
buf = offset + (char *) XSTRING (object)->data;
}
}
object = XPROCESS (proc)->encoding_buf;
len = encode_coding (coding, buf, XSTRING (object)->data,
len, XSTRING (object)->size, &dummy);
buf = XSTRING (object)->data;
if (temp_buf)
xfree (temp_buf);
}
#ifdef VMS #ifdef VMS
vs = get_vms_process_pointer (p->pid); vs = get_vms_process_pointer (p->pid);
...@@ -2853,7 +3099,7 @@ Output from processes can arrive in between bunches.") ...@@ -2853,7 +3099,7 @@ Output from processes can arrive in between bunches.")
move_gap (start); move_gap (start);
start1 = XINT (start); start1 = XINT (start);
send_process (proc, &FETCH_CHAR (start1), XINT (end) - XINT (start), send_process (proc, POS_ADDR (start1), XINT (end) - XINT (start),
Fcurrent_buffer ()); Fcurrent_buffer ());
return Qnil; return Qnil;
...@@ -3715,6 +3961,44 @@ status_notify () ...@@ -3715,6 +3961,44 @@ status_notify ()
UNGCPRO; UNGCPRO;
} }
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).")
(proc, decoding, encoding)
register Lisp_Object proc, decoding, encoding;
{
register struct Lisp_Process *p;
CHECK_PROCESS (proc, 0);
p = XPROCESS (proc);
if (XINT (p->infd) < 0)
error ("Input file descriptor of %s closed", XSTRING (p->name)->data);
if (XINT (p->outfd) < 0)
error ("Output file descriptor of %s closed", XSTRING (p->name)->data);
p->decode_coding_system = Fcheck_coding_system (decoding);
p->encode_coding_system = Fcheck_coding_system (encoding);
setup_coding_system (decoding,
&proc_decode_coding_system[XINT (p->infd)]);
setup_coding_system (encoding,
&proc_encode_coding_system[XINT (p->outfd)]);
return Qnil;
}
DEFUN ("process-coding-system",
Fprocess_coding_system, Sprocess_coding_system, 1, 1, 0,
"Return a cons of coding-system for decoding and encoding of PROCESS.")
(proc)
register Lisp_Object proc;
{
CHECK_PROCESS (proc, 0);
return Fcons (XPROCESS (proc)->decode_coding_system,
XPROCESS (proc)->encode_coding_system);
}
/* The first time this is called, assume keyboard input comes from DESC /* The first time this is called, assume keyboard input comes from DESC
instead of from where we used to expect it. instead of from where we used to expect it.
...@@ -3874,6 +4158,8 @@ The value takes effect when `start-process' is called."); ...@@ -3874,6 +4158,8 @@ The value takes effect when `start-process' is called.");
defsubr (&Ssignal_process); defsubr (&Ssignal_process);
defsubr (&Swaiting_for_user_input_p); defsubr (&Swaiting_for_user_input_p);
/* defsubr (&Sprocess_connection); */ /* defsubr (&Sprocess_connection); */
defsubr (&Sset_process_coding_system);
defsubr (&Sprocess_coding_system);
} }
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment