Mercurial > emacs
changeset 95884:d6a4488883dc
Daniel Engeler <engeler at 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.
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Fri, 13 Jun 2008 08:08:20 +0000 |
parents | 37aeb92752e7 |
children | e858e5baf5b6 |
files | src/ChangeLog src/process.c src/process.h src/sysdep.c src/w32.c src/w32.h |
diffstat | 6 files changed, 999 insertions(+), 45 deletions(-) [+] |
line wrap: on
line diff
--- a/src/ChangeLog Fri Jun 13 08:07:04 2008 +0000 +++ b/src/ChangeLog Fri Jun 13 08:08:20 2008 +0000 @@ -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
--- a/src/process.c Fri Jun 13 08:07:04 2008 +0000 +++ b/src/process.c Fri Jun 13 08:08:20 2008 +0000 @@ -136,9 +136,13 @@ 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 @@ /* 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 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ } 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ #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 @@ else Fprinc (symbol, Qnil); } + else if (SERIALCONN1_P (p)) + { + write_string ("running", -1); + } else Fprinc (symbol, Qnil); @@ -1493,6 +1533,22 @@ (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 @@ 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 @@ } #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 @@ p->childp = contact; p->plist = Fcopy_sequence (Fplist_get (contact, QCplist)); + p->type = Qnetwork; p->buffer = buffer; p->sentinel = sentinel; @@ -4113,6 +4477,7 @@ p->childp = contact; p->plist = Fcopy_sequence (ps->plist); + p->type = Qnetwork; p->buffer = buffer; p->sentinel = ps->sentinel; @@ -4811,7 +5176,7 @@ 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 @@ /* 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ { 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 @@ 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 @@ #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 @@ 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 @@ 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 @@ { 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 @@ 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 @@ 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 @@ 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 @@ 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);
--- a/src/process.h Fri Jun 13 08:07:04 2008 +0000 +++ b/src/process.h Fri Jun 13 08:08:20 2008 +0000 @@ -51,11 +51,14 @@ 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 @@ /* 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;
--- a/src/sysdep.c Fri Jun 13 08:07:04 2008 +0000 +++ b/src/sysdep.c Fri Jun 13 08:08:20 2008 +0000 @@ -166,6 +166,11 @@ #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 @@ 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) */
--- a/src/w32.c Fri Jun 13 08:07:04 2008 +0000 +++ b/src/w32.c Fri Jun 13 08:08:20 2008 +0000 @@ -102,6 +102,13 @@ #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 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ } } + 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 @@ 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
--- a/src/w32.h Fri Jun 13 08:07:04 2008 +0000 +++ b/src/w32.h Fri Jun 13 08:08:20 2008 +0000 @@ -72,6 +72,8 @@ PROCESS_INFORMATION procinfo; volatile int status; char chr; + OVERLAPPED ovl_read; + OVERLAPPED ovl_write; } child_process; #define MAXDESC FD_SETSIZE @@ -99,6 +101,7 @@ #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);