mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-02 08:22:22 +00:00
Code Issues Releases Activity

Daniel Engeler <engeler at gmail.com>

Browse Source 
These changes add serial port access.
* process.c: Add HAVE_SERIAL.
(Fdelete_process, Fprocess_status, Fset_process_buffer)
(Fset_process_filter, Fset_process_sentinel, Fprocess_contact)
(list_processes_1, select_wrapper, Fstop_process)
(Fcontinue_process, Fprocess_send_eof, kill_buffer_processes)
(status_notify): Modify to handle serial processes.
[HAVE_SERIAL] (Fserial_process_configure)
[HAVE_SERIAL] (make_serial_process_unwind, Fmake_serial_process):
New functions.
* process.h (struct Lisp_Process): Add `type'.
* sysdep.c [HAVE_TERMIOS] (serial_open, serial_configure):
New functions.
* w32.c (_sys_read_ahead, sys_read, sys_write): Modify to handle serial ports.
(serial_open, serial_configure) New functions.
* w32.h: Add FILE_SERIAL.
(struct _child_process): Add ovl_read, ovl_write.
This commit is contained in:
Glenn Morris 2008-06-13 08:08:20 +00:00
parent 07d99e7544
commit d888760c95
6 changed files with 999 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
src/ChangeLog
View File

@ -1,3 +1,24 @@
2008-06-13 Daniel Engeler <engeler@gmail.com>
These changes add serial port access.
* process.c: Add HAVE_SERIAL.
(Fdelete_process, Fprocess_status, Fset_process_buffer)
(Fset_process_filter, Fset_process_sentinel, Fprocess_contact)
(list_processes_1, select_wrapper, Fstop_process)
(Fcontinue_process, Fprocess_send_eof, kill_buffer_processes)
(status_notify): Modify to handle serial processes.
[HAVE_SERIAL] (Fserial_process_configure)
[HAVE_SERIAL] (make_serial_process_unwind, Fmake_serial_process):
New functions.
* process.h (struct Lisp_Process): Add `type'.
* sysdep.c [HAVE_TERMIOS] (serial_open, serial_configure):
New functions.
* w32.c (_sys_read_ahead, sys_read, sys_write): Modify to handle
serial ports.
(serial_open, serial_configure) New functions.
* w32.h: Add FILE_SERIAL.
(struct _child_process): Add ovl_read, ovl_write.
2008-06-13 Kenichi Handa <handa@m17n.org>
* dispextern.h (enum lface_attribute_index): New member

496
src/process.c
View File

@ -136,9 +136,13 @@ Lisp_Object Qprocessp;
Lisp_Object Qrun, Qstop, Qsignal;
Lisp_Object Qopen, Qclosed, Qconnect, Qfailed, Qlisten;
Lisp_Object Qlocal, Qipv4, Qdatagram;
Lisp_Object Qreal, Qnetwork, Qserial;
#ifdef AF_INET6
Lisp_Object Qipv6;
#endif
Lisp_Object QCport, QCspeed, QCprocess;
Lisp_Object QCbytesize, QCstopbits, QCparity, Qodd, Qeven;
Lisp_Object QCflowcontrol, Qhw, Qsw, QCsummary;
Lisp_Object QCname, QCbuffer, QChost, QCservice, QCtype;
Lisp_Object QClocal, QCremote, QCcoding;
Lisp_Object QCserver, QCnowait, QCnoquery, QCstop;
@ -155,15 +159,16 @@ extern Lisp_Object QCfamily;
/* QCfilter is defined in keyboard.c. */
extern Lisp_Object QCfilter;
/* a process object is a network connection when its childp field is neither
Qt nor Qnil but is instead a property list (KEY VAL ...). */
#ifdef HAVE_SOCKETS
#define NETCONN_P(p) (CONSP (XPROCESS (p)->childp))
#define NETCONN1_P(p) (CONSP ((p)->childp))
#define NETCONN_P(p) (EQ (XPROCESS (p)->type, Qnetwork))
#define NETCONN1_P(p) (EQ ((p)->type, Qnetwork))
#define SERIALCONN_P(p) (EQ (XPROCESS (p)->type, Qserial))
#define SERIALCONN1_P(p) (EQ ((p)->type, Qserial))
#else
#define NETCONN_P(p) 0
#define NETCONN1_P(p) 0
#define SERIALCONN_P(p) 0
#define SERIALCONN1_P(p) 0
#endif /* HAVE_SOCKETS */
/* Define first descriptor number available for subprocesses. */
@ -186,6 +191,17 @@ extern Lisp_Object QCfilter;
extern char *get_operating_system_release ();
/* Serial processes require termios or Windows. */
#if defined (HAVE_TERMIOS) || defined (WINDOWSNT)
#define HAVE_SERIAL
#endif
#ifdef HAVE_SERIAL
/* From sysdep.c or w32.c */
extern int serial_open (char *port);
extern void serial_configure (struct Lisp_Process *p, Lisp_Object contact);
#endif
#ifndef USE_CRT_DLL
extern int errno;
#endif
@ -784,7 +800,7 @@ nil, indicating the current buffer's process. */)
p = XPROCESS (process);
p->raw_status_new = 0;
if (NETCONN1_P (p))
if (NETCONN1_P (p) || SERIALCONN1_P (p))
{
p->status = Fcons (Qexit, Fcons (make_number (0), Qnil));
p->tick = ++process_tick;
@ -861,7 +877,7 @@ nil, indicating the current buffer's process. */)
status = p->status;
if (CONSP (status))
status = XCAR (status);
if (NETCONN1_P (p))
if (NETCONN1_P (p) || SERIALCONN1_P (p))
{
if (EQ (status, Qexit))
status = Qclosed;
@ -919,7 +935,8 @@ DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0,
doc: /* 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.
For a non-child channel, this is nil. */)
For a network or serial process, this is nil (process is running) or t
\(process is stopped). */)
(process)
register Lisp_Object process;
{
@ -951,7 +968,7 @@ DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer,
CHECK_BUFFER (buffer);
p = XPROCESS (process);
p->buffer = buffer;
if (NETCONN1_P (p))
if (NETCONN1_P (p) || SERIALCONN1_P (p))
p->childp = Fplist_put (p->childp, QCbuffer, buffer);
setup_process_coding_systems (process);
return buffer;
@ -1018,7 +1035,8 @@ The string argument is normally a multibyte string, except:
FD_CLR (p->infd, &non_keyboard_wait_mask);
}
else if (EQ (p->filter, Qt)
&& !EQ (p->command, Qt)) /* Network process not stopped. */
/* Network or serial process not stopped: */
&& !EQ (p->command, Qt))
{
FD_SET (p->infd, &input_wait_mask);
FD_SET (p->infd, &non_keyboard_wait_mask);
@ -1026,7 +1044,7 @@ The string argument is normally a multibyte string, except:
}
p->filter = filter;
if (NETCONN1_P (p))
if (NETCONN1_P (p) || SERIALCONN1_P (p))
p->childp = Fplist_put (p->childp, QCfilter, filter);
setup_process_coding_systems (process);
return filter;
@ -1057,7 +1075,7 @@ It gets two arguments: the process, and a string describing the change. */)
p = XPROCESS (process);
p->sentinel = sentinel;
if (NETCONN1_P (p))
if (NETCONN1_P (p) || SERIALCONN1_P (p))
p->childp = Fplist_put (p->childp, QCsentinel, sentinel);
return sentinel;
}
@ -1162,11 +1180,13 @@ Lisp_Object Fprocess_datagram_address ();
DEFUN ("process-contact", Fprocess_contact, Sprocess_contact,
1, 2, 0,
doc: /* Return the contact info of PROCESS; t for a real child.
For a net connection, the value depends on the optional KEY arg.
If KEY is nil, value is a cons cell of the form (HOST SERVICE),
if KEY is t, the complete contact information for the connection is
returned, else the specific value for the keyword KEY is returned.
See `make-network-process' for a list of keywords. */)
For a network or serial connection, the value depends on the optional
KEY arg. If KEY is nil, value is a cons cell of the form (HOST
SERVICE) for a network connection or (PORT SPEED) for a serial
connection. If KEY is t, the complete contact information for the
connection is returned, else the specific value for the keyword KEY is
returned. See `make-network-process' or `make-serial-process' for a
list of keywords. */)
(process, key)
register Lisp_Object process, key;
{
@ -1182,11 +1202,14 @@ See `make-network-process' for a list of keywords. */)
Fprocess_datagram_address (process));
#endif
if (!NETCONN_P (process) || EQ (key, Qt))
if ((!NETCONN_P (process) && !SERIALCONN_P (process)) || EQ (key, Qt))
return contact;
if (NILP (key))
if (NILP (key) && NETCONN_P (process))
return Fcons (Fplist_get (contact, QChost),
Fcons (Fplist_get (contact, QCservice), Qnil));
if (NILP (key) && SERIALCONN_P (process))
return Fcons (Fplist_get (contact, QCport),
Fcons (Fplist_get (contact, QCspeed), Qnil));
return Fplist_get (contact, key);
}
@ -1225,6 +1248,19 @@ a socket connection. */)
return XPROCESS (process)->type;
}
#endif
DEFUN ("process-type", Fprocess_type, Sprocess_type, 1, 1, 0,
doc: /* Return the connection type of PROCESS.
The value is either the symbol `real', `network', or `serial'.
PROCESS may be a process, a buffer, the name of a process or buffer, or
nil, indicating the current buffer's process. */)
(process)
Lisp_Object process;
{
Lisp_Object proc;
proc = get_process (process);
return XPROCESS (proc)->type;
}
#ifdef HAVE_SOCKETS
DEFUN ("format-network-address", Fformat_network_address, Sformat_network_address,
@ -1325,7 +1361,7 @@ list_processes_1 (query_only)
proc = Fcdr (XCAR (tail));
p = XPROCESS (proc);
if (NILP (p->childp))
if (NILP (p->type))
continue;
if (!NILP (query_only) && p->kill_without_query)
continue;
@ -1393,7 +1429,7 @@ list_processes_1 (query_only)
proc = Fcdr (XCAR (tail));
p = XPROCESS (proc);
if (NILP (p->childp))
if (NILP (p->type))
continue;
if (!NILP (query_only) && p->kill_without_query)
continue;
@ -1418,7 +1454,7 @@ list_processes_1 (query_only)
#endif
Fprinc (symbol, Qnil);
}
else if (NETCONN1_P (p))
else if (NETCONN1_P (p) || SERIALCONN1_P (p))
{
if (EQ (symbol, Qexit))
write_string ("closed", -1);
@ -1429,6 +1465,10 @@ list_processes_1 (query_only)
else
Fprinc (symbol, Qnil);
}
else if (SERIALCONN1_P (p))
{
write_string ("running", -1);
}
else
Fprinc (symbol, Qnil);
@ -1493,6 +1533,22 @@ list_processes_1 (query_only)
(STRINGP (host) ? (char *)SDATA (host) : "?"));
insert_string (tembuf);
}
else if (SERIALCONN1_P (p))
{
Lisp_Object port = Fplist_get (p->childp, QCport);
Lisp_Object speed = Fplist_get (p->childp, QCspeed);
insert_string ("(serial port ");
if (STRINGP (port))
insert_string (SDATA (port));
else
insert_string ("?");
if (INTEGERP (speed))
{
sprintf (tembuf, " at %d b/s", XINT (speed));
insert_string (tembuf);
}
insert_string (")\n");
}
else
{
tem = p->command;
@ -1619,6 +1675,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
XPROCESS (proc)->childp = Qt;
XPROCESS (proc)->plist = Qnil;
XPROCESS (proc)->type = Qreal;
XPROCESS (proc)->buffer = buffer;
XPROCESS (proc)->sentinel = Qnil;
XPROCESS (proc)->filter = Qnil;
@ -2656,6 +2713,312 @@ unwind_request_sigio (dummy)
}
#endif
#ifdef HAVE_SERIAL
DEFUN ("serial-process-configure",
Fserial_process_configure,
Sserial_process_configure,
0, MANY, 0,
doc: /* Configure speed, bytesize, etc. of a serial process.
Arguments are specified as keyword/argument pairs. Attributes that
are not given are re-initialized from the process's current
configuration (available via the function `process-contact') or set to
reasonable default values. The following arguments are defined:
:process PROCESS
:name NAME
:buffer BUFFER
:port PORT
-- Any of these arguments can be given to identify the process that is
to be configured. If none of these arguments is given, the current
buffer's process is used.
:speed SPEED -- SPEED is the speed of the serial port in bits per
second, also called baud rate. Any value can be given for SPEED, but
most serial ports work only at a few defined values between 1200 and
115200, with 9600 being the most common value. If SPEED is nil, the
serial port is not configured any further, i.e., all other arguments
are ignored. This may be useful for special serial ports such as
Bluetooth-to-serial converters which can only be configured through AT
commands. A value of nil for SPEED can be used only when passed
through `make-serial-process' or `serial-term'.
:bytesize BYTESIZE -- BYTESIZE is the number of bits per byte, which
can be 7 or 8. If BYTESIZE is not given or nil, a value of 8 is used.
:parity PARITY -- PARITY can be nil (don't use parity), the symbol
`odd' (use odd parity), or the symbol `even' (use even parity). If
PARITY is not given, no parity is used.
:stopbits STOPBITS -- STOPBITS is the number of stopbits used to
terminate a byte transmission. STOPBITS can be 1 or 2. If STOPBITS
is not given or nil, 1 stopbit is used.
:flowcontrol FLOWCONTROL -- FLOWCONTROL determines the type of
flowcontrol to be used, which is either nil (don't use flowcontrol),
the symbol `hw' (use RTS/CTS hardware flowcontrol), or the symbol `sw'
\(use XON/XOFF software flowcontrol). If FLOWCONTROL is not given, no
flowcontrol is used.
`serial-process-configure' is called by `make-serial-process' for the
initial configuration of the serial port.
Examples:
\(serial-process-configure :process "/dev/ttyS0" :speed 1200)
\(serial-process-configure
:buffer "COM1" :stopbits 1 :parity 'odd :flowcontrol 'hw)
\(serial-process-configure :port "\\\\.\\COM13" :bytesize 7)
usage: (serial-process-configure &rest ARGS) */)
(nargs, args)
int nargs;
Lisp_Object *args;
{
struct Lisp_Process *p;
Lisp_Object contact = Qnil;
Lisp_Object proc = Qnil;
struct gcpro gcpro1;
contact = Flist (nargs, args);
GCPRO1 (contact);
proc = Fplist_get (contact, QCprocess);
if (NILP (proc))
proc = Fplist_get (contact, QCname);
if (NILP (proc))
proc = Fplist_get (contact, QCbuffer);
if (NILP (proc))
proc = Fplist_get (contact, QCport);
proc = get_process (proc);
p = XPROCESS (proc);
if (p->type != Qserial)
error ("Not a serial process");
if (NILP (Fplist_get (p->childp, QCspeed)))
{
UNGCPRO;
return Qnil;
}
serial_configure (p, contact);
UNGCPRO;
return Qnil;
}
#endif /* HAVE_SERIAL */
#ifdef HAVE_SERIAL
/* Used by make-serial-process to recover from errors. */
Lisp_Object make_serial_process_unwind (Lisp_Object proc)
{
if (!PROCESSP (proc))
abort ();
remove_process (proc);
return Qnil;
}
#endif /* HAVE_SERIAL */
#ifdef HAVE_SERIAL
DEFUN ("make-serial-process", Fmake_serial_process, Smake_serial_process,
0, MANY, 0,
doc: /* Create and return a serial port process.
In Emacs, serial port connections are represented by process objects,
so input and output work as for subprocesses, and `delete-process'
closes a serial port connection. However, a serial process has no
process id, it cannot be signaled, and the status codes are different
from normal processes.
`make-serial-process' creates a process and a buffer, on which you
probably want to use `process-send-string'. Try \\[serial-term] for
an interactive terminal. See below for examples.
Arguments are specified as keyword/argument pairs. The following
arguments are defined:
:port PORT -- (mandatory) PORT is the path or name of the serial port.
For example, this could be "/dev/ttyS0" on Unix. On Windows, this
could be "COM1", or "\\\\.\\COM10" for ports higher than COM9 (double
the backslashes in strings).
:speed SPEED -- (mandatory) is handled by `serial-process-configure',
which is called by `make-serial-process'.
:name NAME -- NAME is the name of the process. If NAME is not given,
the value of PORT is used.
:buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
with the process. Process output goes at the end of that buffer,
unless you specify an output stream or filter function to handle the
output. If BUFFER is not given, the value of NAME is used.
:coding CODING -- If CODING is a symbol, it specifies the coding
system used for both reading and writing for this process. If CODING
is a cons (DECODING . ENCODING), DECODING is used for reading, and
ENCODING is used for writing.
:noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
the process is running. If BOOL is not given, query before exiting.
:stop BOOL -- Start process in the `stopped' state if BOOL is non-nil.
In the stopped state, a serial process does not accept incoming data,
but you can send outgoing data. The stopped state is cleared by
`continue-process' and set by `stop-process'.
:filter FILTER -- Install FILTER as the process filter.
:sentinel SENTINEL -- Install SENTINEL as the process sentinel.
:plist PLIST -- Install PLIST as the initial plist of the process.
:speed
:bytesize
:parity
:stopbits
:flowcontrol
-- These arguments are handled by `serial-process-configure', which is
called by `make-serial-process'.
The original argument list, possibly modified by later configuration,
is available via the function `process-contact'.
Examples:
\(make-serial-process :port "/dev/ttyS0" :speed 9600)
\(make-serial-process :port "COM1" :speed 115200 :stopbits 2)
\(make-serial-process :port "\\\\.\\COM13" :speed 1200 :bytesize 7 :parity 'odd)
\(make-serial-process :port "/dev/tty.BlueConsole-SPP-1" :speed nil)
usage: (make-serial-process &rest ARGS) */)
(nargs, args)
int nargs;
Lisp_Object *args;
{
int fd = -1;
Lisp_Object proc, contact, port;
struct Lisp_Process *p;
struct gcpro gcpro1;
Lisp_Object name, buffer;
Lisp_Object tem, val;
int specpdl_count = -1;
if (nargs == 0)
return Qnil;
contact = Flist (nargs, args);
GCPRO1 (contact);
port = Fplist_get (contact, QCport);
if (NILP (port))
error ("No port specified");
CHECK_STRING (port);
if (NILP (Fplist_member (contact, QCspeed)))
error (":speed not specified");
if (!NILP (Fplist_get (contact, QCspeed)))
CHECK_NUMBER (Fplist_get (contact, QCspeed));
name = Fplist_get (contact, QCname);
if (NILP (name))
name = port;
CHECK_STRING (name);
proc = make_process (name);
specpdl_count = SPECPDL_INDEX ();
record_unwind_protect (make_serial_process_unwind, proc);
p = XPROCESS (proc);
fd = serial_open ((char*) SDATA (port));
p->infd = fd;
p->outfd = fd;
if (fd > max_process_desc)
max_process_desc = fd;
chan_process[fd] = proc;
buffer = Fplist_get (contact, QCbuffer);
if (NILP (buffer))
buffer = name;
buffer = Fget_buffer_create (buffer);
p->buffer = buffer;
p->childp = contact;
p->plist = Fcopy_sequence (Fplist_get (contact, QCplist));
p->type = Qserial;
p->sentinel = Fplist_get (contact, QCsentinel);
p->filter = Fplist_get (contact, QCfilter);
p->log = Qnil;
if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
p->kill_without_query = 1;
if (tem = Fplist_get (contact, QCstop), !NILP (tem))
p->command = Qt;
p->pty_flag = 0;
if (!EQ (p->command, Qt))
{
FD_SET (fd, &input_wait_mask);
FD_SET (fd, &non_keyboard_wait_mask);
}
if (BUFFERP (buffer))
{
set_marker_both (p->mark, buffer,
BUF_ZV (XBUFFER (buffer)),
BUF_ZV_BYTE (XBUFFER (buffer)));
}
tem = Fplist_member (contact, QCcoding);
if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem))))
tem = Qnil;
val = Qnil;
if (!NILP (tem))
{
val = XCAR (XCDR (tem));
if (CONSP (val))
val = XCAR (val);
}
else 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)))
val = Qnil;
p->decode_coding_system = val;
val = Qnil;
if (!NILP (tem))
{
val = XCAR (XCDR (tem));
if (CONSP (val))
val = XCDR (val);
}
else if (!NILP (Vcoding_system_for_write))
val = Vcoding_system_for_write;
else if ((!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters))
|| (NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters)))
val = Qnil;
p->encode_coding_system = val;
setup_process_coding_systems (proc);
p->decoding_buf = make_uninit_string (0);
p->decoding_carryover = 0;
p->encoding_buf = make_uninit_string (0);
p->inherit_coding_system_flag
= !(!NILP (tem) || NILP (buffer) || !inherit_process_coding_system);
Fserial_process_configure(nargs, args);
specpdl_ptr = specpdl + specpdl_count;
UNGCPRO;
return proc;
}
#endif /* HAVE_SERIAL */
/* Create a network stream/datagram client/server process. Treated
exactly like a normal process when reading and writing. Primary
differences are in status display and process deletion. A network
@ -3395,6 +3758,7 @@ usage: (make-network-process &rest ARGS) */)
p->childp = contact;
p->plist = Fcopy_sequence (Fplist_get (contact, QCplist));
p->type = Qnetwork;
p->buffer = buffer;
p->sentinel = sentinel;
@ -4113,6 +4477,7 @@ server_accept_connection (server, channel)
p->childp = contact;
p->plist = Fcopy_sequence (ps->plist);
p->type = Qnetwork;
p->buffer = buffer;
p->sentinel = ps->sentinel;
@ -4811,7 +5176,7 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
available now and a closed pipe.
With luck, a closed pipe will be accompanied by
subprocess termination and SIGCHLD. */
else if (nread == 0 && !NETCONN_P (proc))
else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc))
;
#endif /* O_NDELAY */
#endif /* O_NONBLOCK */
@ -4839,7 +5204,7 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
/* If we can detect process termination, don't consider the process
gone just because its pipe is closed. */
#ifdef SIGCHLD
else if (nread == 0 && !NETCONN_P (proc))
else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc))
;
#endif
else
@ -5628,7 +5993,7 @@ send_process (proc, buf, len, object)
this -= rv;
}
/* If we sent just part of the string, put in an EOF
/* If we sent just part of the string, put in an EOF (C-d)
to force it through, before we send the rest. */
if (len > 0)
Fprocess_send_eof (proc);
@ -5748,7 +6113,7 @@ return t unconditionally. */)
proc = get_process (process);
p = XPROCESS (proc);
if (!EQ (p->childp, Qt))
if (!EQ (p->type, Qreal))
error ("Process %s is not a subprocess",
SDATA (p->name));
if (p->infd < 0)
@ -5791,7 +6156,7 @@ process_send_signal (process, signo, current_group, nomsg)
proc = get_process (process);
p = XPROCESS (proc);
if (!EQ (p->childp, Qt))
if (!EQ (p->type, Qreal))
error ("Process %s is not a subprocess",
SDATA (p->name));
if (p->infd < 0)
@ -6040,12 +6405,13 @@ See function `interrupt-process' for more details on usage. */)
DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
doc: /* Stop process PROCESS. May be process or name of one.
See function `interrupt-process' for more details on usage.
If PROCESS is a network process, inhibit handling of incoming traffic. */)
If PROCESS is a network or serial process, inhibit handling of incoming
traffic. */)
(process, current_group)
Lisp_Object process, current_group;
{
#ifdef HAVE_SOCKETS
if (PROCESSP (process) && NETCONN_P (process))
if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process)))
{
struct Lisp_Process *p;
@ -6071,12 +6437,13 @@ If PROCESS is a network process, inhibit handling of incoming traffic. */)
DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
doc: /* Continue process PROCESS. May be process or name of one.
See function `interrupt-process' for more details on usage.
If PROCESS is a network process, resume handling of incoming traffic. */)
If PROCESS is a network or serial process, resume handling of incoming
traffic. */)
(process, current_group)
Lisp_Object process, current_group;
{
#ifdef HAVE_SOCKETS
if (PROCESSP (process) && NETCONN_P (process))
if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process)))
{
struct Lisp_Process *p;
@ -6087,6 +6454,13 @@ If PROCESS is a network process, resume handling of incoming traffic. */)
{
FD_SET (p->infd, &input_wait_mask);
FD_SET (p->infd, &non_keyboard_wait_mask);
#ifdef WINDOWSNT
if (fd_info[ p->infd ].flags & FILE_SERIAL)
PurgeComm (fd_info[ p->infd ].hnd, PURGE_RXABORT | PURGE_RXCLEAR);
#endif
#ifdef HAVE_TERMIOS
tcflush (p->infd, TCIFLUSH);
#endif
}
p->command = Qnil;
return process;
@ -6272,7 +6646,9 @@ 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. */)
text to PROCESS after you call this function.
If PROCESS is a serial process, wait until all output written to the
process has been transmitted to the serial port. */)
(process)
Lisp_Object process;
{
@ -6302,6 +6678,14 @@ text to PROCESS after you call this function. */)
#else
if (XPROCESS (proc)->pty_flag)
send_process (proc, "\004", 1, Qnil);
else if (XPROCESS (proc)->type == Qserial)
{
#ifdef HAVE_TERMIOS
if (tcdrain (XPROCESS (proc)->outfd) != 0)
error ("tcdrain() failed: %s", emacs_strerror (errno));
#endif
/* Do nothing on Windows because writes are blocking. */
}
else
{
int old_outfd, new_outfd;
@ -6311,7 +6695,7 @@ text to PROCESS after you call this function. */)
for communication with the subprocess, call shutdown to cause EOF.
(In some old system, shutdown to socketpair doesn't work.
Then we just can't win.) */
if (XPROCESS (proc)->pid == 0
if (XPROCESS (proc)->type == Qnetwork
|| XPROCESS (proc)->outfd == XPROCESS (proc)->infd)
shutdown (XPROCESS (proc)->outfd, 1);
/* In case of socketpair, outfd == infd, so don't close it. */
@ -6355,7 +6739,7 @@ kill_buffer_processes (buffer)
if (PROCESSP (proc)
&& (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer)))
{
if (NETCONN_P (proc))
if (NETCONN_P (proc) || SERIALCONN_P (proc))
Fdelete_process (proc);
else if (XPROCESS (proc)->infd >= 0)
process_send_signal (proc, SIGHUP, Qnil, 1);
@ -6464,7 +6848,7 @@ sigchld_handler (signo)
{
proc = XCDR (XCAR (tail));
p = XPROCESS (proc);
if (EQ (p->childp, Qt) && p->pid == pid)
if (EQ (p->type, Qreal) && p->pid == pid)
break;
p = 0;
}
@ -6686,7 +7070,8 @@ status_notify (deleting_process)
while (! EQ (p->filter, Qt)
&& ! EQ (p->status, Qconnect)
&& ! EQ (p->status, Qlisten)
&& ! EQ (p->command, Qt) /* Network process not stopped. */
/* Network or serial process not stopped: */
&& ! EQ (p->command, Qt)
&& p->infd >= 0
&& p != deleting_process
&& read_process_output (proc, p->infd) > 0);
@ -7073,6 +7458,39 @@ syms_of_process ()
Qdatagram = intern ("datagram");
staticpro (&Qdatagram);
QCport = intern (":port");
staticpro (&QCport);
QCspeed = intern (":speed");
staticpro (&QCspeed);
QCprocess = intern (":process");
staticpro (&QCprocess);
QCbytesize = intern (":bytesize");
staticpro (&QCbytesize);
QCstopbits = intern (":stopbits");
staticpro (&QCstopbits);
QCparity = intern (":parity");
staticpro (&QCparity);
Qodd = intern ("odd");
staticpro (&Qodd);
Qeven = intern ("even");
staticpro (&Qeven);
QCflowcontrol = intern (":flowcontrol");
staticpro (&QCflowcontrol);
Qhw = intern ("hw");
staticpro (&Qhw);
Qsw = intern ("sw");
staticpro (&Qsw);
QCsummary = intern (":summary");
staticpro (&QCsummary);
Qreal = intern ("real");
staticpro (&Qreal);
Qnetwork = intern ("network");
staticpro (&Qnetwork);
Qserial = intern ("serial");
staticpro (&Qserial);
QCname = intern (":name");
staticpro (&QCname);
QCbuffer = intern (":buffer");
@ -7170,6 +7588,10 @@ The variable takes effect when `start-process' is called. */);
defsubr (&Slist_processes);
defsubr (&Sprocess_list);
defsubr (&Sstart_process);
#ifdef HAVE_SERIAL
defsubr (&Sserial_process_configure);
defsubr (&Smake_serial_process);
#endif /* HAVE_SERIAL */
#ifdef HAVE_SOCKETS
defsubr (&Sset_network_process_option);
defsubr (&Smake_network_process);
@ -7199,7 +7621,7 @@ The variable takes effect when `start-process' is called. */);
defsubr (&Sprocess_send_eof);
defsubr (&Ssignal_process);
defsubr (&Swaiting_for_user_input_p);
/* defsubr (&Sprocess_connection); */
defsubr (&Sprocess_type);
defsubr (&Sset_process_coding_system);
defsubr (&Sprocess_coding_system);
defsubr (&Sset_process_filter_multibyte);

10
src/process.h
View File

@ -51,11 +51,14 @@ struct Lisp_Process
Lisp_Object log;
/* Buffer that output is going to */
Lisp_Object buffer;
/* t if this is a real child process.
For a net connection, it is a plist based on the arguments to make-network-process. */
/* t if this is a real child process. For a network or serial
connection, it is a plist based on the arguments to
make-network-process or make-serial-process. */
Lisp_Object childp;
/* Plist for programs to keep per-process state information, parameters, etc. */
Lisp_Object plist;
/* Symbol indicating the type of process: real, network, serial */
Lisp_Object type;
/* Marker set to end of last buffer-inserted output from this process */
Lisp_Object mark;
/* Symbol indicating status of process.
@ -78,7 +81,8 @@ struct Lisp_Process
/* Number of this process.
allocate_process assumes this is the first non-Lisp_Object field.
A value 0 is used for pseudo-processes such as network connections. */
A value 0 is used for pseudo-processes such as network or serial
connections. */
pid_t pid;
/* Descriptor by which we read from this process */
int infd;

199
src/sysdep.c
View File

@ -166,6 +166,11 @@ extern int quit_char;
#include "process.h"
#include "cm.h" /* for reset_sys_modes */
/* For serial_configure() and serial_open() */
extern Lisp_Object QCport, QCspeed, QCprocess;
extern Lisp_Object QCbytesize, QCstopbits, QCparity, Qodd, Qeven;
extern Lisp_Object QCflowcontrol, Qhw, Qsw, QCsummary;
#ifdef WINDOWSNT
#include <direct.h>
/* In process.h which conflicts with the local copy. */
@ -5379,6 +5384,200 @@ strsignal (code)
return signame;
}
#endif /* HAVE_STRSIGNAL */
#ifdef HAVE_TERMIOS
/* For make-serial-process */
int serial_open (char *port)
{
int fd = -1;
fd = emacs_open ((char*) port,
O_RDWR
#ifdef O_NONBLOCK
| O_NONBLOCK
#else
| O_NDELAY
#endif
#ifdef O_NOCTTY
| O_NOCTTY
#endif
, 0);
if (fd < 0)
{
error ("Could not open %s: %s",
port, emacs_strerror (errno));
}
#ifdef TIOCEXCL
ioctl (fd, TIOCEXCL, (char *) 0);
#endif
return fd;
}
#endif /* TERMIOS */
#ifdef HAVE_TERMIOS
/* For serial-process-configure */
void
serial_configure (struct Lisp_Process *p,
Lisp_Object contact)
{
Lisp_Object childp2 = Qnil;
Lisp_Object tem = Qnil;
struct termios attr;
int err = -1;
char summary[4] = "???"; /* This usually becomes "8N1". */
childp2 = Fcopy_sequence (p->childp);
/* Read port attributes and prepare default configuration. */
err = tcgetattr (p->outfd, &attr);
if (err != 0)
error ("tcgetattr() failed: %s", emacs_strerror (errno));
cfmakeraw (&attr);
#if defined (CLOCAL)
attr.c_cflag |= CLOCAL;
#endif
#if defined (CREAD)
attr.c_cflag | CREAD;
#endif
/* Configure speed. */
if (!NILP (Fplist_member (contact, QCspeed)))
tem = Fplist_get (contact, QCspeed);
else
tem = Fplist_get (p->childp, QCspeed);
CHECK_NUMBER (tem);
err = cfsetspeed (&attr, XINT (tem));
if (err != 0)
error ("cfsetspeed(%d) failed: %s", XINT (tem), emacs_strerror (errno));
childp2 = Fplist_put (childp2, QCspeed, tem);
/* Configure bytesize. */
if (!NILP (Fplist_member (contact, QCbytesize)))
tem = Fplist_get (contact, QCbytesize);
else
tem = Fplist_get (p->childp, QCbytesize);
if (NILP (tem))
tem = make_number (8);
CHECK_NUMBER (tem);
if (XINT (tem) != 7 && XINT (tem) != 8)
error (":bytesize must be nil (8), 7, or 8");
summary[0] = XINT(tem) + '0';
#if defined (CSIZE) && defined (CS7) && defined (CS8)
attr.c_cflag &= ~CSIZE;
attr.c_cflag |= ((XINT (tem) == 7) ? CS7 : CS8);
#else
/* Don't error on bytesize 8, which should be set by cfmakeraw(). */
if (XINT (tem) != 8)
error ("Bytesize cannot be changed");
#endif
childp2 = Fplist_put (childp2, QCbytesize, tem);
/* Configure parity. */
if (!NILP (Fplist_member (contact, QCparity)))
tem = Fplist_get (contact, QCparity);
else
tem = Fplist_get (p->childp, QCparity);
if (!NILP (tem) && !EQ (tem, Qeven) && !EQ (tem, Qodd))
error (":parity must be nil (no parity), `even', or `odd'");
#if defined (PARENB) && defined (PARODD) && defined (IGNPAR) && defined (INPCK)
attr.c_cflag &= ~(PARENB | PARODD);
attr.c_iflag &= ~(IGNPAR | INPCK);
if (NILP (tem))
{
summary[1] = 'N';
}
else if (EQ (tem, Qeven))
{
summary[1] = 'E';
attr.c_cflag |= PARENB;
attr.c_iflag |= (IGNPAR | INPCK);
}
else if (EQ (tem, Qodd))
{
summary[1] = 'O';
attr.c_cflag |= (PARENB | PARODD);
attr.c_iflag |= (IGNPAR | INPCK);
}
#else
/* Don't error on no parity, which should be set by cfmakeraw(). */
if (!NILP (tem))
error ("Parity cannot be configured");
#endif
childp2 = Fplist_put (childp2, QCparity, tem);
/* Configure stopbits. */
if (!NILP (Fplist_member (contact, QCstopbits)))
tem = Fplist_get (contact, QCstopbits);
else
tem = Fplist_get (p->childp, QCstopbits);
if (NILP (tem))
tem = make_number (1);
CHECK_NUMBER (tem);
if (XINT (tem) != 1 && XINT (tem) != 2)
error (":stopbits must be nil (1 stopbit), 1, or 2");
summary[2] = XINT (tem) + '0';
#if defined (CSTOPB)
attr.c_cflag &= ~CSTOPB;
if (XINT (tem) == 2)
attr.c_cflag |= CSTOPB;
#else
/* Don't error on 1 stopbit, which should be set by cfmakeraw(). */
if (XINT (tem) != 1)
error ("Stopbits cannot be configured");
#endif
childp2 = Fplist_put (childp2, QCstopbits, tem);
/* Configure flowcontrol. */
if (!NILP (Fplist_member (contact, QCflowcontrol)))
tem = Fplist_get (contact, QCflowcontrol);
else
tem = Fplist_get (p->childp, QCflowcontrol);
if (!NILP (tem) && !EQ (tem, Qhw) && !EQ (tem, Qsw))
error (":flowcontrol must be nil (no flowcontrol), `hw', or `sw'");
#if defined (CRTSCTS)
attr.c_cflag &= ~CRTSCTS;
#endif
#if defined (CNEW_RTSCTS)
attr.c_cflag &= ~CNEW_RTSCTS;
#endif
#if defined (IXON) && defined (IXOFF)
attr.c_iflag &= ~(IXON | IXOFF);
#endif
if (NILP (tem))
{
/* Already configured. */
}
else if (EQ (tem, Qhw))
{
#if defined (CRTSCTS)
attr.c_cflag |= CRTSCTS;
#elif defined (CNEW_RTSCTS)
attr.c_cflag |= CNEW_RTSCTS;
#else
error ("Hardware flowcontrol (RTS/CTS) not supported");
#endif
}
else if (EQ (tem, Qsw))
{
#if defined (IXON) && defined (IXOFF)
attr.c_iflag |= (IXON | IXOFF);
#else
error ("Software flowcontrol (XON/XOFF) not supported");
#endif
}
childp2 = Fplist_put (childp2, QCflowcontrol, tem);
/* Activate configuration. */
err = tcsetattr (p->outfd, TCSANOW, &attr);
if (err != 0)
error ("tcsetattr() failed: %s", emacs_strerror (errno));
childp2 = Fplist_put (childp2, QCsummary, build_string (summary));
p->childp = childp2;
}
#endif /* TERMIOS */
/* arch-tag: edb43589-4e09-4544-b325-978b5b121dcf
(do not change this comment) */

315
src/w32.c
View File

@ -102,6 +102,13 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "systime.h"
#include "dispextern.h" /* for xstrcasecmp */
/* For serial_configure() and serial_open() */
#include "process.h"
/* From process.c */
extern Lisp_Object QCport, QCspeed, QCprocess;
extern Lisp_Object QCbytesize, QCstopbits, QCparity, Qodd, Qeven;
extern Lisp_Object QCflowcontrol, Qhw, Qsw, QCsummary;
typedef HRESULT (WINAPI * ShGetFolderPath_fn)
(IN HWND, IN int, IN HANDLE, IN DWORD, OUT char *);
@ -4063,10 +4070,10 @@ _sys_read_ahead (int fd)
if (cp == NULL || cp->fd != fd || cp->status != STATUS_READ_READY)
return STATUS_READ_ERROR;
if ((fd_info[fd].flags & (FILE_PIPE | FILE_SOCKET)) == 0
if ((fd_info[fd].flags & (FILE_PIPE | FILE_SERIAL | FILE_SOCKET)) == 0
|| (fd_info[fd].flags & FILE_READ) == 0)
{
DebPrint (("_sys_read_ahead: internal error: fd %d is not a pipe or socket!\n", fd));
DebPrint (("_sys_read_ahead: internal error: fd %d is not a pipe, serial port, or socket!\n", fd));
abort ();
}
@ -4080,7 +4087,7 @@ _sys_read_ahead (int fd)
reporting that input is available; we need this because Windows 95
connects DOS programs to pipes by making the pipe appear to be
the normal console stdout - as a result most DOS programs will
write to stdout without buffering, ie. one character at a
write to stdout without buffering, ie. one character at a
time. Even some W32 programs do this - "dir" in a command
shell on NT is very slow if we don't do this. */
if (rc > 0)
@ -4096,6 +4103,29 @@ _sys_read_ahead (int fd)
Sleep (0);
}
}
else if (fd_info[fd].flags & FILE_SERIAL)
{
HANDLE hnd = fd_info[fd].hnd;
OVERLAPPED *ovl = &fd_info[fd].cp->ovl_read;
COMMTIMEOUTS ct;
/* Configure timeouts for blocking read. */
if (!GetCommTimeouts (hnd, &ct))
return STATUS_READ_ERROR;
ct.ReadIntervalTimeout = 0;
ct.ReadTotalTimeoutMultiplier = 0;
ct.ReadTotalTimeoutConstant = 0;
if (!SetCommTimeouts (hnd, &ct))
return STATUS_READ_ERROR;
if (!ReadFile (hnd, &cp->chr, sizeof (char), (DWORD*) &rc, ovl))
{
if (GetLastError () != ERROR_IO_PENDING)
return STATUS_READ_ERROR;
if (!GetOverlappedResult (hnd, ovl, (DWORD*) &rc, TRUE))
return STATUS_READ_ERROR;
}
}
#ifdef HAVE_SOCKETS
else if (fd_info[fd].flags & FILE_SOCKET)
{
@ -4167,7 +4197,7 @@ sys_read (int fd, char * buffer, unsigned int count)
return -1;
}
if (fd < MAXDESC && fd_info[fd].flags & (FILE_PIPE | FILE_SOCKET))
if (fd < MAXDESC && fd_info[fd].flags & (FILE_PIPE | FILE_SOCKET | FILE_SERIAL))
{
child_process *cp = fd_info[fd].cp;
@ -4238,6 +4268,52 @@ sys_read (int fd, char * buffer, unsigned int count)
if (to_read > 0)
nchars += _read (fd, buffer, to_read);
}
else if (fd_info[fd].flags & FILE_SERIAL)
{
HANDLE hnd = fd_info[fd].hnd;
OVERLAPPED *ovl = &fd_info[fd].cp->ovl_read;
DWORD err = 0;
int rc = 0;
COMMTIMEOUTS ct;
if (count > 0)
{
/* Configure timeouts for non-blocking read. */
if (!GetCommTimeouts (hnd, &ct))
{
errno = EIO;
return -1;
}
ct.ReadIntervalTimeout = MAXDWORD;
ct.ReadTotalTimeoutMultiplier = 0;
ct.ReadTotalTimeoutConstant = 0;
if (!SetCommTimeouts (hnd, &ct))
{
errno = EIO;
return -1;
}
if (!ResetEvent (ovl->hEvent))
{
errno = EIO;
return -1;
}
if (!ReadFile (hnd, buffer, count, (DWORD*) &rc, ovl))
{
if (GetLastError () != ERROR_IO_PENDING)
{
errno = EIO;
return -1;
}
if (!GetOverlappedResult (hnd, ovl, (DWORD*) &rc, TRUE))
{
errno = EIO;
return -1;
}
}
nchars += rc;
}
}
#ifdef HAVE_SOCKETS
else /* FILE_SOCKET */
{
@ -4299,6 +4375,9 @@ sys_read (int fd, char * buffer, unsigned int count)
return nchars;
}
/* From w32xfns.c */
extern HANDLE interrupt_handle;
/* For now, don't bother with a non-blocking mode */
int
sys_write (int fd, const void * buffer, unsigned int count)
@ -4311,7 +4390,7 @@ sys_write (int fd, const void * buffer, unsigned int count)
return -1;
}
if (fd < MAXDESC && fd_info[fd].flags & (FILE_PIPE | FILE_SOCKET))
if (fd < MAXDESC && fd_info[fd].flags & (FILE_PIPE | FILE_SOCKET | FILE_SERIAL))
{
if ((fd_info[fd].flags & FILE_WRITE) == 0)
{
@ -4352,6 +4431,42 @@ sys_write (int fd, const void * buffer, unsigned int count)
}
}
if (fd < MAXDESC && fd_info[fd].flags & FILE_SERIAL)
{
HANDLE hnd = (HANDLE) _get_osfhandle (fd);
OVERLAPPED *ovl = &fd_info[fd].cp->ovl_write;
HANDLE wait_hnd[2] = { interrupt_handle, ovl->hEvent };
DWORD active = 0;
if (!WriteFile (hnd, buffer, count, (DWORD*) &nchars, ovl))
{
if (GetLastError () != ERROR_IO_PENDING)
{
errno = EIO;
return -1;
}
if (detect_input_pending ())
active = MsgWaitForMultipleObjects (2, wait_hnd, FALSE, INFINITE,
QS_ALLINPUT);
else
active = WaitForMultipleObjects (2, wait_hnd, FALSE, INFINITE);
if (active == WAIT_OBJECT_0)
{ /* User pressed C-g, cancel write, then leave. Don't bother
cleaning up as we may only get stuck in buggy drivers. */
PurgeComm (hnd, PURGE_TXABORT | PURGE_TXCLEAR);
CancelIo (hnd);
errno = EIO;
return -1;
}
if (active == WAIT_OBJECT_0 + 1
&& !GetOverlappedResult (hnd, ovl, (DWORD*) &nchars, TRUE))
{
errno = EIO;
return -1;
}
}
}
else
#ifdef HAVE_SOCKETS
if (fd < MAXDESC && fd_info[fd].flags & FILE_SOCKET)
{
@ -4612,6 +4727,196 @@ globals_of_w32 ()
strcpy (dflt_group_name, "None");
}
/* For make-serial-process */
int serial_open (char *port)
{
HANDLE hnd;
child_process *cp;
int fd = -1;
hnd = CreateFile (port, GENERIC_READ | GENERIC_WRITE, 0, 0,
OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);
if (hnd == INVALID_HANDLE_VALUE)
error ("Could not open %s", port);
fd = (int) _open_osfhandle ((int) hnd, 0);
if (fd == -1)
error ("Could not open %s", port);
cp = new_child ();
if (!cp)
error ("Could not create child process");
cp->fd = fd;
cp->status = STATUS_READ_ACKNOWLEDGED;
fd_info[ fd ].hnd = hnd;
fd_info[ fd ].flags |=
FILE_READ | FILE_WRITE | FILE_BINARY | FILE_SERIAL;
if (fd_info[ fd ].cp != NULL)
{
error ("fd_info[fd = %d] is already in use", fd);
}
fd_info[ fd ].cp = cp;
cp->ovl_read.hEvent = CreateEvent (NULL, TRUE, FALSE, NULL);
if (cp->ovl_read.hEvent == NULL)
error ("Could not create read event");
cp->ovl_write.hEvent = CreateEvent (NULL, TRUE, FALSE, NULL);
if (cp->ovl_write.hEvent == NULL)
error ("Could not create write event");
return fd;
}
/* For serial-process-configure */
void
serial_configure (struct Lisp_Process *p,
Lisp_Object contact)
{
Lisp_Object childp2 = Qnil;
Lisp_Object tem = Qnil;
HANDLE hnd;
DCB dcb;
COMMTIMEOUTS ct;
char summary[4] = "???"; /* This usually becomes "8N1". */
if ((fd_info[ p->outfd ].flags & FILE_SERIAL) == 0)
error ("Not a serial process");
hnd = fd_info[ p->outfd ].hnd;
childp2 = Fcopy_sequence (p->childp);
/* Initialize timeouts for blocking read and blocking write. */
if (!GetCommTimeouts (hnd, &ct))
error ("GetCommTimeouts() failed");
ct.ReadIntervalTimeout = 0;
ct.ReadTotalTimeoutMultiplier = 0;
ct.ReadTotalTimeoutConstant = 0;
ct.WriteTotalTimeoutMultiplier = 0;
ct.WriteTotalTimeoutConstant = 0;
if (!SetCommTimeouts (hnd, &ct))
error ("SetCommTimeouts() failed");
/* Read port attributes and prepare default configuration. */
memset (&dcb, 0, sizeof (dcb));
dcb.DCBlength = sizeof (DCB);
if (!GetCommState (hnd, &dcb))
error ("GetCommState() failed");
dcb.fBinary = TRUE;
dcb.fNull = FALSE;
dcb.fAbortOnError = FALSE;
/* dcb.XonLim and dcb.XoffLim are set by GetCommState() */
dcb.ErrorChar = 0;
dcb.EofChar = 0;
dcb.EvtChar = 0;
/* Configure speed. */
if (!NILP (Fplist_member (contact, QCspeed)))
tem = Fplist_get (contact, QCspeed);
else
tem = Fplist_get (p->childp, QCspeed);
CHECK_NUMBER (tem);
dcb.BaudRate = XINT (tem);
childp2 = Fplist_put (childp2, QCspeed, tem);
/* Configure bytesize. */
if (!NILP (Fplist_member (contact, QCbytesize)))
tem = Fplist_get (contact, QCbytesize);
else
tem = Fplist_get (p->childp, QCbytesize);
if (NILP (tem))
tem = make_number (8);
CHECK_NUMBER (tem);
if (XINT (tem) != 7 && XINT (tem) != 8)
error (":bytesize must be nil (8), 7, or 8");
dcb.ByteSize = XINT (tem);
summary[0] = XINT (tem) + '0';
childp2 = Fplist_put (childp2, QCbytesize, tem);
/* Configure parity. */
if (!NILP (Fplist_member (contact, QCparity)))
tem = Fplist_get (contact, QCparity);
else
tem = Fplist_get (p->childp, QCparity);
if (!NILP (tem) && !EQ (tem, Qeven) && !EQ (tem, Qodd))
error (":parity must be nil (no parity), `even', or `odd'");
dcb.fParity = FALSE;
dcb.Parity = NOPARITY;
dcb.fErrorChar = FALSE;
if (NILP (tem))
{
summary[1] = 'N';
}
else if (EQ (tem, Qeven))
{
summary[1] = 'E';
dcb.fParity = TRUE;
dcb.Parity = EVENPARITY;
dcb.fErrorChar = TRUE;
}
else if (EQ (tem, Qodd))
{
summary[1] = 'O';
dcb.fParity = TRUE;
dcb.Parity = ODDPARITY;
dcb.fErrorChar = TRUE;
}
childp2 = Fplist_put (childp2, QCparity, tem);
/* Configure stopbits. */
if (!NILP (Fplist_member (contact, QCstopbits)))
tem = Fplist_get (contact, QCstopbits);
else
tem = Fplist_get (p->childp, QCstopbits);
if (NILP (tem))
tem = make_number (1);
CHECK_NUMBER (tem);
if (XINT (tem) != 1 && XINT (tem) != 2)
error (":stopbits must be nil (1 stopbit), 1, or 2");
summary[2] = XINT (tem) + '0';
if (XINT (tem) == 1)
dcb.StopBits = ONESTOPBIT;
else if (XINT (tem) == 2)
dcb.StopBits = TWOSTOPBITS;
childp2 = Fplist_put (childp2, QCstopbits, tem);
/* Configure flowcontrol. */
if (!NILP (Fplist_member (contact, QCflowcontrol)))
tem = Fplist_get (contact, QCflowcontrol);
else
tem = Fplist_get (p->childp, QCflowcontrol);
if (!NILP (tem) && !EQ (tem, Qhw) && !EQ (tem, Qsw))
error (":flowcontrol must be nil (no flowcontrol), `hw', or `sw'");
dcb.fOutxCtsFlow = FALSE;
dcb.fOutxDsrFlow = FALSE;
dcb.fDtrControl = DTR_CONTROL_DISABLE;
dcb.fDsrSensitivity = FALSE;
dcb.fTXContinueOnXoff = FALSE;
dcb.fOutX = FALSE;
dcb.fInX = FALSE;
dcb.fRtsControl = RTS_CONTROL_DISABLE;
dcb.XonChar = 17; /* Control-Q */
dcb.XoffChar = 19; /* Control-S */
if (NILP (tem))
{
/* Already configured. */
}
else if (EQ (tem, Qhw))
{
dcb.fRtsControl = RTS_CONTROL_HANDSHAKE;
dcb.fOutxCtsFlow = TRUE;
}
else if (EQ (tem, Qsw))
{
dcb.fOutX = TRUE;
dcb.fInX = TRUE;
}
childp2 = Fplist_put (childp2, QCflowcontrol, tem);
/* Activate configuration. */
if (!SetCommState (hnd, &dcb))
error ("SetCommState() failed");
childp2 = Fplist_put (childp2, QCsummary, build_string (summary));
p->childp = childp2;
}
/* end of w32.c */
/* arch-tag: 90442dd3-37be-482b-b272-ac752e3049f1

3
src/w32.h
View File

@ -72,6 +72,8 @@ typedef struct _child_process
PROCESS_INFORMATION procinfo;
volatile int status;
char chr;
OVERLAPPED ovl_read;
OVERLAPPED ovl_write;
} child_process;
#define MAXDESC FD_SETSIZE
@ -99,6 +101,7 @@ extern filedesc fd_info [ MAXDESC ];
#define FILE_PIPE 0x0100
#define FILE_SOCKET 0x0200
#define FILE_NDELAY 0x0400
#define FILE_SERIAL 0x0800
extern child_process * new_child (void);
extern void delete_child (child_process *cp);