From: "Daniel Engeler" <engeler@gmail.com>
To: emacs-devel@gnu.org
Cc: eliz@gnu.org, monnier@iro.umontreal.ca
Subject: Contribution: Serial port access
Date: Thu, 5 Jun 2008 23:35:53 +0200 [thread overview]
Message-ID: <b2e57ce30806051435n9e69b1ft3744abdc98b0d81f@mail.gmail.com> (raw)
In-Reply-To: <73E47418-2ADD-4682-91CB-D3F0C94B1662@gmail.com>
[-- Attachment #1: Type: text/plain, Size: 204 bytes --]
Hi Stefan, Eli,
Now that my paperwork is done, please find attached the final diff of
my contribution. I already sent this file to Eli on May 7, 2008, and
haven't changed it since.
Kind regards,
Daniel
[-- Attachment #2: engeler-serial-2.diff --]
[-- Type: application/octet-stream, Size: 90597 bytes --]
Index: doc/emacs/emacs.texi
===================================================================
RCS file: /sources/emacs/emacs/doc/emacs/emacs.texi,v
retrieving revision 1.9
diff -c -p -r1.9 emacs.texi
*** doc/emacs/emacs.texi 23 Apr 2008 05:55:36 -0000 1.9
--- doc/emacs/emacs.texi 7 May 2008 18:52:38 -0000
*************** Running Shell Commands from Emacs
*** 864,869 ****
--- 864,870 ----
* Term Mode:: Special Emacs commands used in Term mode.
* Paging in Term:: Paging in the terminal emulator.
* Remote Host:: Connecting to another computer.
+ * Serial Terminal:: Connecting to a serial port.
Using Emacs as a Server
Index: doc/emacs/misc.texi
===================================================================
RCS file: /sources/emacs/emacs/doc/emacs/misc.texi,v
retrieving revision 1.5
diff -c -p -r1.5 misc.texi
*** doc/emacs/misc.texi 22 Jan 2008 23:53:32 -0000 1.5
--- doc/emacs/misc.texi 7 May 2008 18:52:40 -0000
*************** Eshell: The Emacs Shell}.
*** 350,355 ****
--- 350,356 ----
* Term Mode:: Special Emacs commands used in Term mode.
* Paging in Term:: Paging in the terminal emulator.
* Remote Host:: Connecting to another computer.
+ * Serial Terminal:: Connecting to a serial port.
@end menu
@node Single Shell
*************** handles each one appropriately, changing
*** 1076,1082 ****
appearance of the window matches what it would be on a real terminal.
You can actually run Emacs inside an Emacs Term window.
! The file name used to load the subshell is determined the same way
as for Shell mode. To make multiple terminal emulators, rename the
buffer @samp{*terminal*} to something different using @kbd{M-x
rename-uniquely}, just as with Shell mode.
--- 1077,1086 ----
appearance of the window matches what it would be on a real terminal.
You can actually run Emacs inside an Emacs Term window.
! You can use Term mode to communicate with a device connected to a
! serial port of your computer, see @ref{Serial Terminal}.
!
! The file name used to load the subshell is determined the same way
as for Shell mode. To make multiple terminal emulators, rename the
buffer @samp{*terminal*} to something different using @kbd{M-x
rename-uniquely}, just as with Shell mode.
*************** off directory tracking.
*** 1232,1237 ****
--- 1236,1268 ----
@end ignore
+ @node Serial Terminal
+ @subsection Serial Terminal
+ @cindex terminal, serial
+ @findex serial-term
+
+ If you have a device connected to a serial port of your computer,
+ you can use Emacs to communicate with it. @kbd{M-x serial-term} will
+ ask you for a serial port name and speed and will then open a new
+ window in @ref{Term Mode}.
+
+ The speed of the serial port is measured in bits per second. The
+ most common speed is 9600 bits per second. You can change the speed
+ interactively by clicking on the mode line.
+
+ A serial port can be configured even more by clicking on ``8N1'' in
+ the mode line. By default, a serial port is configured as ``8N1'',
+ which means that each byte consists of 8 data bits, No parity check
+ bit, and 1 stopbit.
+
+ When you have opened the serial port connection, you will see output
+ from the device in the window. Also, what you type in the window is
+ sent to the device.
+
+ If the speed or the configuration is wrong, you cannot communicate
+ with your device and will probably only see garbage output in the
+ window.
+
@node Emacs Server, Printing, Shell, Top
@section Using Emacs as a Server
@pindex emacsclient
Index: doc/lispref/elisp.texi
===================================================================
RCS file: /sources/emacs/emacs/doc/lispref/elisp.texi,v
retrieving revision 1.6
diff -c -p -r1.6 elisp.texi
*** doc/lispref/elisp.texi 13 Mar 2008 03:15:39 -0000 1.6
--- doc/lispref/elisp.texi 7 May 2008 18:52:44 -0000
*************** Processes
*** 1195,1200 ****
--- 1195,1201 ----
* Low-Level Network:: Lower-level but more general function
to create connections and servers.
* Misc Network:: Additional relevant functions for network connections.
+ * Serial Ports:: Communicating with serial ports.
* Byte Packing:: Using bindat to pack and unpack binary data.
Receiving Output from Processes
Index: doc/lispref/internals.texi
===================================================================
RCS file: /sources/emacs/emacs/doc/lispref/internals.texi,v
retrieving revision 1.3
diff -c -p -r1.3 internals.texi
*** doc/lispref/internals.texi 8 Jan 2008 20:45:46 -0000 1.3
--- doc/lispref/internals.texi 7 May 2008 18:52:46 -0000
*************** A string, the name of the process.
*** 1433,1439 ****
@item command
A list containing the command arguments that were used to start this
! process.
@item filter
A function used to accept output from the process instead of a buffer,
--- 1433,1440 ----
@item command
A list containing the command arguments that were used to start this
! process. For a network or serial process, it is @code{nil} if the
! process is running or @code{t} if the process is stopped.
@item filter
A function used to accept output from the process instead of a buffer,
*************** The associated buffer of the process.
*** 1449,1456 ****
An integer, the operating system's process @acronym{ID}.
@item childp
A flag, non-@code{nil} if this is really a child process.
! It is @code{nil} for a network connection.
@item mark
A marker indicating the position of the end of the last output from this
--- 1450,1458 ----
An integer, the operating system's process @acronym{ID}.
@item childp
+
A flag, non-@code{nil} if this is really a child process.
! It is @code{nil} for a network or serial connection.
@item mark
A marker indicating the position of the end of the last output from this
*************** Size of carryover in encoding.
*** 1515,1520 ****
--- 1517,1527 ----
@item inherit_coding_system_flag
Flag to set @code{coding-system} of the process buffer from the
coding system used to decode process output.
+
+ @item type
+ Symbol indicating the type of process: @code{real}, @code{network},
+ @code{serial}
+
@end table
@ignore
Index: doc/lispref/processes.texi
===================================================================
RCS file: /sources/emacs/emacs/doc/lispref/processes.texi,v
retrieving revision 1.5
diff -c -p -r1.5 processes.texi
*** doc/lispref/processes.texi 25 Mar 2008 17:50:06 -0000 1.5
--- doc/lispref/processes.texi 7 May 2008 18:52:48 -0000
*************** This function returns @code{t} if @var{o
*** 53,58 ****
--- 53,59 ----
* Low-Level Network:: Lower-level but more general function
to create connections and servers.
* Misc Network:: Additional relevant functions for network connections.
+ * Serial Ports:: Communicating with serial ports.
* Byte Packing:: Using bindat to pack and unpack binary data.
@end menu
*************** were given to the program.
*** 676,681 ****
--- 677,725 ----
@end smallexample
@end defun
+ @defun process-contact process &optional key
+
+ This function returns information about how a network or serial
+ process was set up. For a network process, when @var{key} is
+ @code{nil}, it returns @code{(@var{hostname} @var{service})} which
+ specifies what you connected to. For a serial process, when @var{key}
+ is @code{nil}, it returns @code{(@var{port} @var{speed})}. For an
+ ordinary child process, this function always returns @code{t}.
+
+ If @var{key} is @code{t}, the value is the complete status information
+ for the connection, server, or serial port; that is, the list of
+ keywords and values specified in @code{make-network-process} or
+ @code{make-serial-process}, except that some of the values represent
+ the current status instead of what you specified.
+
+ For a network process:
+
+ @table @code
+ @item :buffer
+ The associated value is the process buffer.
+ @item :filter
+ The associated value is the process filter function.
+ @item :sentinel
+ The associated value is the process sentinel function.
+ @item :remote
+ In a connection, the address in internal format of the remote peer.
+ @item :local
+ The local address, in internal format.
+ @item :service
+ In a server, if you specified @code{t} for @var{service},
+ this value is the actual port number.
+ @end table
+
+ @code{:local} and @code{:remote} are included even if they were not
+ specified explicitly in @code{make-network-process}.
+
+ For a serial process, see @code{make-serial-process} and
+ @code{serial-process-configure} for a list of keys.
+
+ If @var{key} is a keyword, the function returns the value corresponding
+ to that keyword.
+ @end defun
+
@defun process-id process
This function returns the @acronym{PID} of @var{process}. This is an
integer that distinguishes the process @var{process} from all other
*************** For a network connection, @code{process-
*** 742,747 ****
--- 786,797 ----
closed the connection, or Emacs did @code{delete-process}.
@end defun
+ @defun process-type process
+ This function returns the symbol @code{network} for a network
+ connection or server, @code{serial} for a serial port connection, or
+ @code{real} for a real subprocess.
+ @end defun
+
@defun process-exit-status process
This function returns the exit status of @var{process} or the signal
number that killed it. (Use the result of @code{process-status} to
*************** server process, or @code{:type 'datagram
*** 1593,1603 ****
connection. @xref{Low-Level Network}, for details. You can also use
the @code{open-network-stream} function described below.
! You can distinguish process objects representing network connections
! and servers from those representing subprocesses with the
! @code{process-status} function. The possible status values for
! network connections are @code{open}, @code{closed}, @code{connect},
! and @code{failed}. For a network server, the status is always
@code{listen}. None of those values is possible for a real
subprocess. @xref{Process Information}.
--- 1643,1656 ----
connection. @xref{Low-Level Network}, for details. You can also use
the @code{open-network-stream} function described below.
! To distinguish the different types of processes, the
! @code{process-type} function returns the symbol @code{network} for a
! network connection or server, @code{serial} for a serial port
! connection, or @code{real} for a real subprocess.
!
! The @code{process-status} function returns @code{open},
! @code{closed}, @code{connect}, and @code{failed} for network
! connections. For a network server, the status is always
@code{listen}. None of those values is possible for a real
subprocess. @xref{Process Information}.
*************** The arguments @var{host} and @var{servic
*** 1631,1672 ****
a defined network service (a string) or a port number (an integer).
@end defun
- @defun process-contact process &optional key
- This function returns information about how a network process was set
- up. For a connection, when @var{key} is @code{nil}, it returns
- @code{(@var{hostname} @var{service})} which specifies what you
- connected to.
-
- If @var{key} is @code{t}, the value is the complete status information
- for the connection or server; that is, the list of keywords and values
- specified in @code{make-network-process}, except that some of the
- values represent the current status instead of what you specified:
-
- @table @code
- @item :buffer
- The associated value is the process buffer.
- @item :filter
- The associated value is the process filter function.
- @item :sentinel
- The associated value is the process sentinel function.
- @item :remote
- In a connection, the address in internal format of the remote peer.
- @item :local
- The local address, in internal format.
- @item :service
- In a server, if you specified @code{t} for @var{service},
- this value is the actual port number.
- @end table
-
- @code{:local} and @code{:remote} are included even if they were not
- specified explicitly in @code{make-network-process}.
-
- If @var{key} is a keyword, the function returns the value corresponding
- to that keyword.
-
- For an ordinary child process, this function always returns @code{t}.
- @end defun
-
@node Network Servers
@section Network Servers
@cindex network servers
--- 1684,1689 ----
*************** If the vector does not include the port
*** 2099,2104 ****
--- 2116,2307 ----
@code{:@var{p}} suffix.
@end defun
+ @node Serial Ports
+ @section Communicating with Serial Ports
+ @cindex @file{/dev/tty}
+ @cindex @file{COM1}
+
+ Emacs can communicate with serial ports. For interactive use,
+ @kbd{M-x serial-term} opens a terminal window. In a Lisp program,
+ @code{make-serial-process} creates a process object.
+
+ The serial port can be configured at run-time, without having to
+ close and re-open it. The function @code{serial-process-configure}
+ lets you change the speed, bytesize, and other parameters. In a
+ terminal window created by @code{serial-term}, you can click on the
+ mode line for configuration.
+
+ A serial connection is represented by a process object which can be
+ used similar to a subprocess or network process. You can send and
+ receive data and configure the serial port. A serial process object
+ has no process ID, and you can't send signals to it.
+ @code{delete-process} on the process object or @code{kill-buffer} on
+ the process buffer close the connection, but this does not affect the
+ device connected to the serial port.
+
+ The function @code{process-type} returns the symbol @code{serial}
+ for a process object representing a serial port.
+
+ Serial ports are available on GNU/Linux, Unix, and Windows systems.
+
+ @defun serial-term port speed
+ Start a terminal-emulator for a serial port in a new buffer.
+ @var{port} is the path or name of the serial port. For example, this
+ could be @file{/dev/ttyS0} on Unix. On Windows, this could be
+ @file{COM1}, or @file{\\.\COM10} (double the backslashes in strings).
+
+ @var{speed} is the speed of the serial port in bits per second. 9600
+ is a common value. The buffer is in Term mode; see @code{term-mode}
+ for the commands to use in that buffer. You can change the speed and
+ the configuration in the mode line menu. @end defun
+
+ @defun make-serial-process &rest args
+ @code{make-serial-process} creates a process and a buffer. Arguments
+ are specified as keyword/argument pairs. The following arguments are
+ defined:
+
+ @table @code
+ @item :port port
+ @var{port} (mandatory) is the path or name of the serial port.
+ For example, this could be @file{/dev/ttyS0} on Unix. On Windows,
+ this could be @file{COM1}, or @file{\\.\COM10} for ports higher than
+ @file{COM9} (double the backslashes in strings).
+
+ @item :speed speed
+ @var{speed} (mandatory) is handled by @code{serial-process-configure},
+ which is called by @code{make-serial-process}.
+
+ @item :name name
+ @var{name} is the name of the process. If @var{name} is not given, the
+ value of @var{port} is used.
+
+ @item :buffer buffer
+ @var{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
+ @var{buffer} is not given, the value of @var{name} is used.
+
+ @item :coding coding
+ If @var{coding} is a symbol, it specifies the coding system used for
+ both reading and writing for this process. If @var{coding} is a cons
+ @code{(decoding . encoding)}, @var{decoding} is used for reading, and
+ @var{encoding} is used for writing.
+
+ @item :noquery bool
+ When exiting Emacs, query the user if @var{bool} is @code{nil} and the
+ process is running. If @var{bool} is not given, query before exiting.
+
+ @item :stop bool
+ Start process in the @code{stopped} state if @var{bool} is
+ non-@code{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 @code{continue-process} and set by
+ @code{stop-process}.
+
+ @item :filter filter
+ Install @var{filter} as the process filter.
+
+ @item :sentinel sentinel
+ Install @var{sentinel} as the process sentinel.
+
+ @item :plist plist
+ Install @var{plist} as the initial plist of the process.
+
+ @item :speed
+ @itemx :bytesize
+ @itemx :parity
+ @itemx :stopbits
+ @itemx :flowcontrol
+ These arguments are handled by @code{serial-process-configure}, which
+ is called by @code{make-serial-process}.
+ @end table
+
+ The original argument list, possibly modified by later configuration,
+ is available via the function @code{process-contact}.
+
+ Examples:
+
+ @example
+ (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)
+ @end example
+ @end defun
+
+ @defun serial-process-configure &rest args
+ @cindex baud
+ @cindex bytesize
+ @cindex parity
+ @cindex stopbits
+ @cindex flowcontrol
+
+ Configure a serial port. 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
+ @code{process-contact}) or set to reasonable default values. The
+ following arguments are defined:
+
+ @table @code
+ @item :process process
+ @itemx :name name
+ @itemx :buffer buffer
+ @itemx :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.
+
+ @item :speed @var{speed}
+ @var{speed} is the speed of the serial port in bits per second, also
+ called baud rate. Any value can be given for @var{speed}, but most
+ serial ports work only at a few defined values between 1200 and
+ 115200, with 9600 being the most common value. If @var{speed} is
+ @code{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 @code{nil} for @var{speed}
+ can be used only when passed through @code{make-serial-process} or
+ @code{serial-term}.
+
+ @item :bytesize @var{bytesize}
+ @var{bytesize} is the number of bits per byte, which can be 7 or 8.
+ If @var{bytesize} is not given or @code{nil}, a value of 8 is used.
+
+ @item :parity @var{parity}
+ @var{parity} can be @code{nil} (don't use parity), the symbol
+ @code{odd} (use odd parity), or the symbol @code{even} (use even
+ parity). If @var{parity} is not given, no parity is used.
+
+ @item :stopbits @var{stopbits}
+ @var{stopbits} is the number of stopbits used to terminate a byte
+ transmission. @var{stopbits} can be 1 or 2. If @var{stopbits} is not
+ given or @code{nil}, 1 stopbit is used.
+
+ @item :flowcontrol @var{flowcontrol}
+ @var{flowcontrol} determines the type of flowcontrol to be used, which
+ is either @code{nil} (don't use flowcontrol), the symbol @code{hw}
+ (use RTS/CTS hardware flowcontrol), or the symbol @code{sw} (use
+ XON/XOFF software flowcontrol). If @var{flowcontrol} is not given, no
+ flowcontrol is used.
+ @end table
+
+ @code{serial-process-configure} is called by @code{make-serial-process} for the
+ initial configuration of the serial port.
+
+ Examples:
+
+ @example
+ (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)
+ @end example
+ @end defun
+
@node Byte Packing
@section Packing and Unpacking Byte Arrays
@cindex byte packing and unpacking
Index: lisp/term.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/term.el,v
retrieving revision 1.102
diff -c -p -r1.102 term.el
*** lisp/term.el 6 May 2008 07:57:54 -0000 1.102
--- lisp/term.el 7 May 2008 18:52:54 -0000
*************** you type \\[term-send-input] which sends
*** 1275,1292 ****
(term-update-mode-line)))
(defun term-update-mode-line ()
! (setq mode-line-process
! (if (term-in-char-mode)
! (if (term-pager-enabled) '(": char page %s") '(": char %s"))
! (if (term-pager-enabled) '(": line page %s") '(": line %s"))))
(force-mode-line-update))
(defun term-check-proc (buffer)
! "True if there is a process associated w/buffer BUFFER, and
! it is alive (status RUN or STOP). BUFFER can be either a buffer or the
! name of one."
(let ((proc (get-buffer-process buffer)))
! (and proc (memq (process-status proc) '(run stop)))))
;;;###autoload
(defun make-term (name program &optional startfile &rest switches)
--- 1275,1316 ----
(term-update-mode-line)))
(defun term-update-mode-line ()
! (let ((term-mode (if (term-in-char-mode) "char" "line"))
! (term-page (when (term-pager-enabled) " page"))
! (serial-item-speed)
! (serial-item-config)
! (temp)
! (proc (get-buffer-process (current-buffer))))
! (when (and (term-check-proc (current-buffer))
! (equal (process-type nil) 'serial))
! (let ((temp (serial-speed)))
! (setq serial-item-speed
! `(:propertize
! ,(or (and temp (format " %d" temp)) "")
! help-echo "mouse-1: Change the speed of the serial port"
! mouse-face mode-line-highlight
! local-map (keymap (mode-line keymap
! (down-mouse-1 . serial-mode-line-speed-menu-1))))))
! (let ((temp (process-contact proc :summary)))
! (setq serial-item-config
! `(:propertize
! ,(or (and temp (format " %s" temp)) "")
! help-echo "mouse-1: Change the configuration of the serial port"
! mouse-face mode-line-highlight
! local-map (keymap (mode-line keymap
! (down-mouse-1 . serial-mode-line-config-menu-1)))))))
! (setq mode-line-process
! (list ": " term-mode term-page
! serial-item-speed
! serial-item-config
! " %s")))
(force-mode-line-update))
(defun term-check-proc (buffer)
! "True if there is a process associated w/buffer BUFFER, and it
! is alive. BUFFER can be either a buffer or the name of one."
(let ((proc (get-buffer-process buffer)))
! (and proc (memq (process-status proc) '(run stop open listen connect)))))
;;;###autoload
(defun make-term (name program &optional startfile &rest switches)
*************** the process. Any more args are argument
*** 4203,4208 ****
--- 4227,4464 ----
(switch-to-buffer term-ansi-buffer-name))
\f
+ ;;; Serial terminals
+ ;;; ===========================================================================
+ (defun serial-port-is-file-p ()
+ "Guess whether serial ports are files on this system.
+ Return t if this is a Unix-based system, where serial ports are
+ files, such as /dev/ttyS0.
+ Return nil if this is Windows or DOS, where serial ports have
+ special identifiers such as COM1."
+ (not (member system-type (list 'windows-nt 'cygwin 'ms-dos))))
+
+ (defvar serial-name-history
+ (if (serial-port-is-file-p)
+ (or (when (file-exists-p "/dev/ttys0") (list "/dev/ttys0"))
+ (when (file-exists-p "/dev/ttyS0") (list "/dev/ttyS0")))
+ (list "COM1"))
+ "History of serial ports used by `serial-read-name'.")
+
+ (defvar serial-speed-history
+ ;; Initialised with reasonable values for newbies.
+ (list "9600" ;; Given twice because 9600 b/s is the most common speed
+ "1200" "2400" "4800" "9600" "14400" "19200"
+ "28800" "38400" "57600" "115200")
+ "History of serial port speeds used by `serial-read-speed'.")
+
+ (defun serial-nice-speed-history ()
+ "Return `serial-speed-history' cleaned up for a mouse-menu."
+ (let ((x) (y))
+ (setq x
+ (sort
+ (copy-sequence serial-speed-history)
+ '(lambda (a b) (when (and (stringp a) (stringp b))
+ (> (string-to-number a) (string-to-number b))))))
+ (dolist (i x) (when (not (equal i (car y))) (push i y)))
+ y))
+
+ (defconst serial-no-speed "nil"
+ "String for `serial-read-speed' for special serial ports.
+ If `serial-read-speed' reads this string from the user, it
+ returns nil, which is recognized by `serial-process-configure'
+ for special serial ports that cannot be configured.")
+
+ (defun serial-supported-or-barf ()
+ "Signal an error if serial processes are not supported"
+ (unless (fboundp 'make-serial-process)
+ (error "Serial processes are not supported on this system")))
+
+ (defun serial-read-name ()
+ "Read a serial port name from the user.
+ Try to be nice by providing useful defaults and history.
+ On Windows, prepend \\.\ to the port name unless it already
+ contains a backslash. This handles the legacy ports COM1-COM9 as
+ well as the newer ports COM10 and higher."
+ (serial-supported-or-barf)
+ (let* ((file-name-history serial-name-history)
+ (h (car file-name-history))
+ (x (if (serial-port-is-file-p)
+ (read-file-name
+ ;; `prompt': The most recently used port is provided as
+ ;; the default value, which is used when the user
+ ;; simply presses return.
+ (if (stringp h) (format "Serial port (default %s): " h)
+ "Serial port: ")
+ ;; `directory': Most systems have their serial ports
+ ;; in the same directory, so start in the directory
+ ;; of the most recently used port, or in a reasonable
+ ;; default directory.
+ (or (and h (file-name-directory h))
+ (and (file-exists-p "/dev/") "/dev/")
+ (and (file-exists-p "/") "/"))
+ ;; `default': This causes (read-file-name) to return
+ ;; the empty string if he user simply presses return.
+ ;; Using nil here may result in a default directory
+ ;; of the current buffer, which is not useful for
+ ;; serial port.
+ "")
+ (read-from-minibuffer
+ (if (stringp h) (format "Serial port (default %s): " h)
+ "Serial port: ")
+ nil nil nil '(file-name-history . 1) nil nil))))
+ (if (or (null x) (and (stringp x) (zerop (length x))))
+ (setq x h)
+ (setq serial-name-history file-name-history))
+ (when (or (null x) (and (stringp x) (zerop (length x))))
+ (error "No serial port selected"))
+ (when (and (not (serial-port-is-file-p))
+ (not (string-match "\\\\" x)))
+ (set 'x (concat "\\\\.\\" x)))
+ x))
+
+ (defun serial-read-speed ()
+ "Read a serial port speed (in bits per second) from the user.
+ Try to be nice by providing useful defaults and history."
+ (serial-supported-or-barf)
+ (let* ((history serial-speed-history)
+ (h (car history))
+ (x (read-from-minibuffer
+ (cond ((string= h serial-no-speed)
+ "Speed (default nil = set by port): ")
+ (h
+ (format "Speed (default %s b/s): " h))
+ (t
+ (format "Speed (b/s): ")))
+ nil nil nil '(history . 1) nil nil)))
+ (when (or (null x) (and (stringp x) (zerop (length x))))
+ (setq x h))
+ (when (or (null x) (not (stringp x)) (zerop (length x)))
+ (error "Invalid speed"))
+ (if (string= x serial-no-speed)
+ (setq x nil)
+ (setq x (string-to-number x))
+ (when (or (null x) (not (integerp x)) (<= x 0))
+ (error "Invalid speed")))
+ (setq serial-speed-history history)
+ x))
+
+ ;;;###autoload
+ (defun serial-term (port speed)
+ "Start a terminal-emulator for a serial port in a new buffer.
+ 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\".
+ SPEED is the speed of the serial port in bits per second. 9600
+ is a common value. SPEED can be nil, see
+ `serial-process-configure' for details.
+ The buffer is in Term mode; see `term-mode' for the commands to
+ use in that buffer.
+ \\<term-raw-map>Type \\[switch-to-buffer] to switch to another buffer."
+ (interactive (list (serial-read-name) (serial-read-speed)))
+ (serial-supported-or-barf)
+ (let* ((process (make-serial-process
+ :port port
+ :speed speed
+ :coding 'no-conversion
+ :noquery t))
+ (buffer (process-buffer process)))
+ (save-excursion
+ (set-buffer buffer)
+ (term-mode)
+ (term-char-mode)
+ (goto-char (point-max))
+ (set-marker (process-mark process) (point))
+ (set-process-filter process 'term-emulate-terminal)
+ (set-process-sentinel process 'term-sentinel))
+ (switch-to-buffer buffer)
+ buffer))
+
+ (defvar serial-mode-line-speed-menu nil)
+ (defvar serial-mode-line-config-menu nil)
+
+ (defun serial-speed ()
+ "Return the speed of the serial port of the current buffer's process.
+ The return value may be nil for a special serial port."
+ (process-contact (get-buffer-process (current-buffer)) :speed))
+
+ (defun serial-mode-line-speed-menu-1 (event)
+ (interactive "e")
+ (save-selected-window
+ (select-window (posn-window (event-start event)))
+ (serial-update-speed-menu)
+ (let* ((selection (serial-mode-line-speed-menu event))
+ (binding (and selection (lookup-key serial-mode-line-speed-menu
+ (vector (car selection))))))
+ (when binding (call-interactively binding)))))
+
+ (defun serial-mode-line-speed-menu (event)
+ (x-popup-menu event serial-mode-line-speed-menu))
+
+ (defun serial-update-speed-menu ()
+ (setq serial-mode-line-speed-menu (make-sparse-keymap "Speed (b/s)"))
+ (define-key serial-mode-line-speed-menu [serial-mode-line-speed-menu-other]
+ '(menu-item "Other..."
+ (lambda (event) (interactive "e")
+ (let ((speed (serial-read-speed)))
+ (serial-process-configure :speed speed)
+ (term-update-mode-line)
+ (message "Speed set to %d b/s" speed)))))
+ (dolist (str (serial-nice-speed-history))
+ (let ((num (or (and (stringp str) (string-to-number str)) 0)))
+ (define-key
+ serial-mode-line-speed-menu
+ (vector (make-symbol (format "serial-mode-line-speed-menu-%s" str)))
+ `(menu-item
+ ,str
+ (lambda (event) (interactive "e")
+ (serial-process-configure :speed ,num)
+ (term-update-mode-line)
+ (message "Speed set to %d b/s" ,num))
+ :button (:toggle . (= (serial-speed) ,num)))))))
+
+ (defun serial-mode-line-config-menu-1 (event)
+ (interactive "e")
+ (save-selected-window
+ (select-window (posn-window (event-start event)))
+ (serial-update-config-menu)
+ (let* ((selection (serial-mode-line-config-menu event))
+ (binding (and selection (lookup-key serial-mode-line-config-menu
+ (vector (car selection))))))
+ (when binding (call-interactively binding)))))
+
+ (defun serial-mode-line-config-menu (event)
+ (x-popup-menu event serial-mode-line-config-menu))
+
+ (defun serial-update-config-menu ()
+ (setq serial-mode-line-config-menu (make-sparse-keymap "Configuration"))
+ (let ((config (process-contact
+ (get-buffer-process (current-buffer)) t))
+ (y)
+ (str))
+ (dolist (y '((:flowcontrol hw "Hardware flowcontrol (RTS/CTS)")
+ (:flowcontrol sw "Software flowcontrol (XON/XOFF)")
+ (:flowcontrol nil "No flowcontrol")
+ (:stopbits 2 "2 stopbits")
+ (:stopbits 1 "1 stopbit")
+ (:parity odd "Odd parity")
+ (:parity even "Even parity")
+ (:parity nil "No parity")
+ (:bytesize 7 "7 bits per byte")
+ (:bytesize 8 "8 bits per byte")))
+ (define-key serial-mode-line-config-menu
+ (vector (make-symbol (format "%s-%s" (nth 0 y) (nth 1 y))))
+ `(menu-item
+ ,(nth 2 y)
+ (lambda (event) (interactive "e")
+ (serial-process-configure ,(nth 0 y) ',(nth 1 y))
+ (term-update-mode-line)
+ (message "%s" ,(nth 2 y)))
+ ;; Use :toggle instead of :radio because a non-standard port
+ ;; configuration may not match any menu items.
+ :button (:toggle . ,(equal (plist-get config (nth 0 y))
+ (nth 1 y))))))))
+
+ \f
;;; Converting process modes to use term mode
;;; ===========================================================================
;;; Renaming variables
Index: src/process.c
===================================================================
RCS file: /sources/emacs/emacs/src/process.c,v
retrieving revision 1.539
diff -c -p -r1.539 process.c
*** src/process.c 9 Apr 2008 06:46:39 -0000 1.539
--- src/process.c 7 May 2008 18:53:00 -0000
*************** Lisp_Object Qprocessp;
*** 138,146 ****
--- 138,150 ----
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;
*************** extern Lisp_Object QCfamily;
*** 157,171 ****
/* 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))
#else
#define NETCONN_P(p) 0
#define NETCONN1_P(p) 0
#endif /* HAVE_SOCKETS */
/* Define first descriptor number available for subprocesses. */
--- 161,176 ----
/* QCfilter is defined in keyboard.c. */
extern Lisp_Object QCfilter;
#ifdef HAVE_SOCKETS
! #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. */
*************** extern Lisp_Object QCfilter;
*** 188,193 ****
--- 193,209 ----
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
*************** nil, indicating the current buffer's pro
*** 786,792 ****
p = XPROCESS (process);
p->raw_status_new = 0;
! if (NETCONN1_P (p))
{
p->status = Fcons (Qexit, Fcons (make_number (0), Qnil));
p->tick = ++process_tick;
--- 802,808 ----
p = XPROCESS (process);
p->raw_status_new = 0;
! if (NETCONN1_P (p) || SERIALCONN1_P (p))
{
p->status = Fcons (Qexit, Fcons (make_number (0), Qnil));
p->tick = ++process_tick;
*************** nil, indicating the current buffer's pro
*** 863,869 ****
status = p->status;
if (CONSP (status))
status = XCAR (status);
! if (NETCONN1_P (p))
{
if (EQ (status, Qexit))
status = Qclosed;
--- 879,885 ----
status = p->status;
if (CONSP (status))
status = XCAR (status);
! if (NETCONN1_P (p) || SERIALCONN1_P (p))
{
if (EQ (status, Qexit))
status = Qclosed;
*************** DEFUN ("process-command", Fprocess_comma
*** 921,927 ****
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. */)
(process)
register Lisp_Object process;
{
--- 937,944 ----
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 network or serial process, this is nil (process is running) or t
! \(process is stopped). */)
(process)
register Lisp_Object process;
{
*************** DEFUN ("set-process-buffer", Fset_proces
*** 953,959 ****
CHECK_BUFFER (buffer);
p = XPROCESS (process);
p->buffer = buffer;
! if (NETCONN1_P (p))
p->childp = Fplist_put (p->childp, QCbuffer, buffer);
setup_process_coding_systems (process);
return buffer;
--- 970,976 ----
CHECK_BUFFER (buffer);
p = XPROCESS (process);
p->buffer = buffer;
! if (NETCONN1_P (p) || SERIALCONN1_P (p))
p->childp = Fplist_put (p->childp, QCbuffer, buffer);
setup_process_coding_systems (process);
return buffer;
*************** The string argument is normally a multib
*** 1020,1026 ****
FD_CLR (p->infd, &non_keyboard_wait_mask);
}
else if (EQ (p->filter, Qt)
! && !EQ (p->command, Qt)) /* Network process not stopped. */
{
FD_SET (p->infd, &input_wait_mask);
FD_SET (p->infd, &non_keyboard_wait_mask);
--- 1037,1044 ----
FD_CLR (p->infd, &non_keyboard_wait_mask);
}
else if (EQ (p->filter, Qt)
! /* 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);
*************** The string argument is normally a multib
*** 1028,1034 ****
}
p->filter = filter;
! if (NETCONN1_P (p))
p->childp = Fplist_put (p->childp, QCfilter, filter);
setup_process_coding_systems (process);
return filter;
--- 1046,1052 ----
}
p->filter = filter;
! if (NETCONN1_P (p) || SERIALCONN1_P (p))
p->childp = Fplist_put (p->childp, QCfilter, filter);
setup_process_coding_systems (process);
return filter;
*************** It gets two arguments: the process, and
*** 1059,1065 ****
p = XPROCESS (process);
p->sentinel = sentinel;
! if (NETCONN1_P (p))
p->childp = Fplist_put (p->childp, QCsentinel, sentinel);
return sentinel;
}
--- 1077,1083 ----
p = XPROCESS (process);
p->sentinel = sentinel;
! if (NETCONN1_P (p) || SERIALCONN1_P (p))
p->childp = Fplist_put (p->childp, QCsentinel, sentinel);
return sentinel;
}
*************** Lisp_Object Fprocess_datagram_address ()
*** 1164,1174 ****
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. */)
(process, key)
register Lisp_Object process, key;
{
--- 1182,1194 ----
DEFUN ("process-contact", Fprocess_contact, Sprocess_contact,
1, 2, 0,
doc: /* Return the contact info of PROCESS; t for a real child.
! 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;
{
*************** See `make-network-process' for a list of
*** 1184,1194 ****
Fprocess_datagram_address (process));
#endif
! if (!NETCONN_P (process) || EQ (key, Qt))
return contact;
! if (NILP (key))
return Fcons (Fplist_get (contact, QChost),
Fcons (Fplist_get (contact, QCservice), Qnil));
return Fplist_get (contact, key);
}
--- 1204,1217 ----
Fprocess_datagram_address (process));
#endif
! if ((!NETCONN_P (process) && !SERIALCONN_P (process)) || EQ (key, Qt))
return contact;
! 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);
}
*************** a socket connection. */)
*** 1227,1232 ****
--- 1250,1268 ----
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,
*************** list_processes_1 (query_only)
*** 1327,1333 ****
proc = Fcdr (XCAR (tail));
p = XPROCESS (proc);
! if (NILP (p->childp))
continue;
if (!NILP (query_only) && p->kill_without_query)
continue;
--- 1363,1369 ----
proc = Fcdr (XCAR (tail));
p = XPROCESS (proc);
! if (NILP (p->type))
continue;
if (!NILP (query_only) && p->kill_without_query)
continue;
*************** list_processes_1 (query_only)
*** 1395,1401 ****
proc = Fcdr (XCAR (tail));
p = XPROCESS (proc);
! if (NILP (p->childp))
continue;
if (!NILP (query_only) && p->kill_without_query)
continue;
--- 1431,1437 ----
proc = Fcdr (XCAR (tail));
p = XPROCESS (proc);
! if (NILP (p->type))
continue;
if (!NILP (query_only) && p->kill_without_query)
continue;
*************** list_processes_1 (query_only)
*** 1420,1426 ****
#endif
Fprinc (symbol, Qnil);
}
! else if (NETCONN1_P (p))
{
if (EQ (symbol, Qexit))
write_string ("closed", -1);
--- 1456,1462 ----
#endif
Fprinc (symbol, Qnil);
}
! else if (NETCONN1_P (p) || SERIALCONN1_P (p))
{
if (EQ (symbol, Qexit))
write_string ("closed", -1);
*************** list_processes_1 (query_only)
*** 1431,1436 ****
--- 1467,1476 ----
else
Fprinc (symbol, Qnil);
}
+ else if (SERIALCONN1_P (p))
+ {
+ write_string ("running", -1);
+ }
else
Fprinc (symbol, Qnil);
*************** list_processes_1 (query_only)
*** 1495,1500 ****
--- 1535,1556 ----
(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;
*************** usage: (start-process NAME BUFFER PROGRA
*** 1621,1626 ****
--- 1677,1683 ----
XPROCESS (proc)->childp = Qt;
XPROCESS (proc)->plist = Qnil;
+ XPROCESS (proc)->type = Qreal;
XPROCESS (proc)->buffer = buffer;
XPROCESS (proc)->sentinel = Qnil;
XPROCESS (proc)->filter = Qnil;
*************** unwind_request_sigio (dummy)
*** 2658,2663 ****
--- 2715,3026 ----
}
#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
*************** usage: (make-network-process &rest ARGS)
*** 3397,3402 ****
--- 3760,3766 ----
p->childp = contact;
p->plist = Fcopy_sequence (Fplist_get (contact, QCplist));
+ p->type = Qnetwork;
p->buffer = buffer;
p->sentinel = sentinel;
*************** server_accept_connection (server, channe
*** 4115,4120 ****
--- 4479,4485 ----
p->childp = contact;
p->plist = Fcopy_sequence (ps->plist);
+ p->type = Qnetwork;
p->buffer = buffer;
p->sentinel = ps->sentinel;
*************** wait_reading_process_output (time_limit,
*** 4807,4813 ****
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))
;
#endif /* O_NDELAY */
#endif /* O_NONBLOCK */
--- 5172,5178 ----
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) && !SERIALCONN_P (proc))
;
#endif /* O_NDELAY */
#endif /* O_NONBLOCK */
*************** wait_reading_process_output (time_limit,
*** 4835,4841 ****
/* 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))
;
#endif
else
--- 5200,5206 ----
/* 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) && !SERIALCONN_P (proc))
;
#endif
else
*************** send_process (proc, buf, len, object)
*** 5624,5630 ****
this -= rv;
}
! /* If we sent just part of the string, put in an EOF
to force it through, before we send the rest. */
if (len > 0)
Fprocess_send_eof (proc);
--- 5989,5995 ----
this -= rv;
}
! /* 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);
*************** return t unconditionally. */)
*** 5744,5750 ****
proc = get_process (process);
p = XPROCESS (proc);
! if (!EQ (p->childp, Qt))
error ("Process %s is not a subprocess",
SDATA (p->name));
if (p->infd < 0)
--- 6109,6115 ----
proc = get_process (process);
p = XPROCESS (proc);
! if (!EQ (p->type, Qreal))
error ("Process %s is not a subprocess",
SDATA (p->name));
if (p->infd < 0)
*************** process_send_signal (process, signo, cur
*** 5787,5793 ****
proc = get_process (process);
p = XPROCESS (proc);
! if (!EQ (p->childp, Qt))
error ("Process %s is not a subprocess",
SDATA (p->name));
if (p->infd < 0)
--- 6152,6158 ----
proc = get_process (process);
p = XPROCESS (proc);
! if (!EQ (p->type, Qreal))
error ("Process %s is not a subprocess",
SDATA (p->name));
if (p->infd < 0)
*************** See function `interrupt-process' for mor
*** 6036,6047 ****
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. */)
(process, current_group)
Lisp_Object process, current_group;
{
#ifdef HAVE_SOCKETS
! if (PROCESSP (process) && NETCONN_P (process))
{
struct Lisp_Process *p;
--- 6401,6413 ----
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 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) || SERIALCONN_P (process)))
{
struct Lisp_Process *p;
*************** If PROCESS is a network process, inhibit
*** 6067,6078 ****
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. */)
(process, current_group)
Lisp_Object process, current_group;
{
#ifdef HAVE_SOCKETS
! if (PROCESSP (process) && NETCONN_P (process))
{
struct Lisp_Process *p;
--- 6433,6445 ----
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 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) || SERIALCONN_P (process)))
{
struct Lisp_Process *p;
*************** If PROCESS is a network process, resume
*** 6083,6088 ****
--- 6450,6462 ----
{
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;
*************** PROCESS may be a process, a buffer, the
*** 6268,6274 ****
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. */)
(process)
Lisp_Object process;
{
--- 6642,6650 ----
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.
! 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;
{
*************** text to PROCESS after you call this func
*** 6298,6303 ****
--- 6674,6687 ----
#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;
*************** text to PROCESS after you call this func
*** 6307,6313 ****
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
|| XPROCESS (proc)->outfd == XPROCESS (proc)->infd)
shutdown (XPROCESS (proc)->outfd, 1);
/* In case of socketpair, outfd == infd, so don't close it. */
--- 6691,6697 ----
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)->type == Qnetwork
|| XPROCESS (proc)->outfd == XPROCESS (proc)->infd)
shutdown (XPROCESS (proc)->outfd, 1);
/* In case of socketpair, outfd == infd, so don't close it. */
*************** kill_buffer_processes (buffer)
*** 6351,6357 ****
if (PROCESSP (proc)
&& (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer)))
{
! if (NETCONN_P (proc))
Fdelete_process (proc);
else if (XPROCESS (proc)->infd >= 0)
process_send_signal (proc, SIGHUP, Qnil, 1);
--- 6735,6741 ----
if (PROCESSP (proc)
&& (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer)))
{
! if (NETCONN_P (proc) || SERIALCONN_P (proc))
Fdelete_process (proc);
else if (XPROCESS (proc)->infd >= 0)
process_send_signal (proc, SIGHUP, Qnil, 1);
*************** sigchld_handler (signo)
*** 6460,6466 ****
{
proc = XCDR (XCAR (tail));
p = XPROCESS (proc);
! if (EQ (p->childp, Qt) && p->pid == pid)
break;
p = 0;
}
--- 6844,6850 ----
{
proc = XCDR (XCAR (tail));
p = XPROCESS (proc);
! if (EQ (p->type, Qreal) && p->pid == pid)
break;
p = 0;
}
*************** status_notify (deleting_process)
*** 6682,6688 ****
while (! EQ (p->filter, Qt)
&& ! EQ (p->status, Qconnect)
&& ! EQ (p->status, Qlisten)
! && ! EQ (p->command, Qt) /* Network process not stopped. */
&& p->infd >= 0
&& p != deleting_process
&& read_process_output (proc, p->infd) > 0);
--- 7066,7073 ----
while (! EQ (p->filter, Qt)
&& ! EQ (p->status, Qconnect)
&& ! EQ (p->status, Qlisten)
! /* Network or serial process not stopped: */
! && ! EQ (p->command, Qt)
&& p->infd >= 0
&& p != deleting_process
&& read_process_output (proc, p->infd) > 0);
*************** syms_of_process ()
*** 7069,7074 ****
--- 7454,7492 ----
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");
*************** The variable takes effect when `start-pr
*** 7166,7171 ****
--- 7584,7593 ----
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);
*************** The variable takes effect when `start-pr
*** 7195,7201 ****
defsubr (&Sprocess_send_eof);
defsubr (&Ssignal_process);
defsubr (&Swaiting_for_user_input_p);
! /* defsubr (&Sprocess_connection); */
defsubr (&Sset_process_coding_system);
defsubr (&Sprocess_coding_system);
defsubr (&Sset_process_filter_multibyte);
--- 7617,7623 ----
defsubr (&Sprocess_send_eof);
defsubr (&Ssignal_process);
defsubr (&Swaiting_for_user_input_p);
! defsubr (&Sprocess_type);
defsubr (&Sset_process_coding_system);
defsubr (&Sprocess_coding_system);
defsubr (&Sset_process_filter_multibyte);
Index: src/process.h
===================================================================
RCS file: /sources/emacs/emacs/src/process.h,v
retrieving revision 1.43
diff -c -p -r1.43 process.h
*** src/process.h 25 Mar 2008 17:35:47 -0000 1.43
--- src/process.h 7 May 2008 18:53:00 -0000
*************** struct Lisp_Process
*** 53,63 ****
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. */
Lisp_Object childp;
/* Plist for programs to keep per-process state information, parameters, etc. */
Lisp_Object plist;
/* Marker set to end of last buffer-inserted output from this process */
Lisp_Object mark;
/* Symbol indicating status of process.
--- 53,66 ----
Lisp_Object log;
/* Buffer that output is going to */
Lisp_Object buffer;
! /* 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.
*************** struct Lisp_Process
*** 80,86 ****
/* 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. */
pid_t pid;
/* Descriptor by which we read from this process */
int infd;
--- 83,90 ----
/* 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 or serial
! connections. */
pid_t pid;
/* Descriptor by which we read from this process */
int infd;
Index: src/sysdep.c
===================================================================
RCS file: /sources/emacs/emacs/src/sysdep.c,v
retrieving revision 1.296
diff -c -p -r1.296 sysdep.c
*** src/sysdep.c 9 Apr 2008 06:46:14 -0000 1.296
--- src/sysdep.c 7 May 2008 18:53:04 -0000
*************** extern int quit_char;
*** 168,173 ****
--- 168,178 ----
#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. */
*************** strsignal (code)
*** 5374,5379 ****
--- 5379,5578 ----
return signame;
}
#endif /* HAVE_STRSIGNAL */
+ \f
+ #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) */
Index: src/w32.c
===================================================================
RCS file: /sources/emacs/emacs/src/w32.c,v
retrieving revision 1.136
diff -c -p -r1.136 w32.c
*** src/w32.c 23 Apr 2008 05:55:33 -0000 1.136
--- src/w32.c 7 May 2008 18:53:07 -0000
*************** Boston, MA 02110-1301, USA.
*** 102,107 ****
--- 102,114 ----
#include "w32heap.h"
#include "systime.h"
+ /* 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 *);
*************** _sys_read_ahead (int fd)
*** 3803,3812 ****
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
|| (fd_info[fd].flags & FILE_READ) == 0)
{
! DebPrint (("_sys_read_ahead: internal error: fd %d is not a pipe or socket!\n", fd));
abort ();
}
--- 3810,3819 ----
if (cp == NULL || cp->fd != fd || cp->status != STATUS_READ_READY)
return STATUS_READ_ERROR;
! 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, serial port, or socket!\n", fd));
abort ();
}
*************** _sys_read_ahead (int fd)
*** 3820,3826 ****
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
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)
--- 3827,3833 ----
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
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)
*************** _sys_read_ahead (int fd)
*** 3836,3841 ****
--- 3843,3871 ----
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)
{
*************** sys_read (int fd, char * buffer, unsigne
*** 3907,3913 ****
return -1;
}
! if (fd < MAXDESC && fd_info[fd].flags & (FILE_PIPE | FILE_SOCKET))
{
child_process *cp = fd_info[fd].cp;
--- 3937,3943 ----
return -1;
}
! if (fd < MAXDESC && fd_info[fd].flags & (FILE_PIPE | FILE_SOCKET | FILE_SERIAL))
{
child_process *cp = fd_info[fd].cp;
*************** sys_read (int fd, char * buffer, unsigne
*** 3978,3983 ****
--- 4008,4059 ----
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 */
{
*************** sys_read (int fd, char * buffer, unsigne
*** 4039,4044 ****
--- 4115,4123 ----
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)
*************** sys_write (int fd, const void * buffer,
*** 4051,4057 ****
return -1;
}
! if (fd < MAXDESC && fd_info[fd].flags & (FILE_PIPE | FILE_SOCKET))
{
if ((fd_info[fd].flags & FILE_WRITE) == 0)
{
--- 4130,4136 ----
return -1;
}
! if (fd < MAXDESC && fd_info[fd].flags & (FILE_PIPE | FILE_SOCKET | FILE_SERIAL))
{
if ((fd_info[fd].flags & FILE_WRITE) == 0)
{
*************** sys_write (int fd, const void * buffer,
*** 4092,4097 ****
--- 4171,4212 ----
}
}
+ 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)
{
*************** globals_of_w32 ()
*** 4345,4350 ****
--- 4460,4655 ----
SetConsoleCtrlHandler(shutdown_handler, TRUE);
}
+ /* 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
Index: src/w32.h
===================================================================
RCS file: /sources/emacs/emacs/src/w32.h,v
retrieving revision 1.25
diff -c -p -r1.25 w32.h
*** src/w32.h 8 Jan 2008 20:44:15 -0000 1.25
--- src/w32.h 7 May 2008 18:53:07 -0000
*************** typedef struct _child_process
*** 74,79 ****
--- 74,81 ----
PROCESS_INFORMATION procinfo;
volatile int status;
char chr;
+ OVERLAPPED ovl_read;
+ OVERLAPPED ovl_write;
} child_process;
#define MAXDESC FD_SETSIZE
*************** extern filedesc fd_info [ MAXDESC ];
*** 101,106 ****
--- 103,109 ----
#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);
next prev parent reply other threads:[~2008-06-05 21:35 UTC|newest]
Thread overview: 9+ messages / expand[flat|nested] mbox.gz Atom feed top
2008-04-21 20:36 Contribution: Serial port access Daniel Engeler
2008-04-22 17:45 ` Eli Zaretskii
[not found] ` <73E47418-2ADD-4682-91CB-D3F0C94B1662@gmail.com>
2008-06-05 21:35 ` Daniel Engeler [this message]
2008-06-06 6:11 ` Stefan Monnier
2008-06-12 4:08 ` Glenn Morris
2008-06-12 13:13 ` Stefan Monnier
2008-06-12 20:06 ` Daniel Engeler
2008-06-13 8:09 ` Glenn Morris
2008-06-07 10:56 ` Thien-Thi Nguyen
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=b2e57ce30806051435n9e69b1ft3744abdc98b0d81f@mail.gmail.com \
--to=engeler@gmail.com \
--cc=eliz@gnu.org \
--cc=emacs-devel@gnu.org \
--cc=monnier@iro.umontreal.ca \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).