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);