if 0 {
I had a need to control a serial device with a command-line interface from Windows. expect would be perfect for the job, but expect under Windows is, as of this writing, in an intermediate state of development. I did not want to use the cygwin version of expect. All the same, some kind of send-expect programming interface would make my task simpler.
Therefore, I used the expect man page to inspire the following "quickie" rendition of something expect-like in pure Tcl. It operates on a Tcl I/O channel and does the key part of expect, waiting for a response from the remote side, which may be embedded in stuff we don't care about. It does not do any of the very nice pseudo-tty stuff real expect does, nor does it include expect's send command. Use it with open and puts.
It works by converting its parameters into the parameters for switch, then reads the incoming channel a character at a time, testing the accumulated characters with switch each time.
Corrections, extensions, rewrites, or outright replacement with something better would be welcome. I've never had the pleasure of using genuine expect, so I apologize if I missed something important.
- SCT }
#
# qexpect: "quasi-expect" or "quickie expect"
#
# Usage:
# qexpect channel [pat1 body1] ...
# qexpect channel { [pat1 body1] ... }
#
# Patterns use glob matching. The special pattern "eof" matches end of file.
# If a pattern starts with ^, it must match starting with the first character
# of the input. If a pattern ends with $, it must match ending with the last character
# received. If it neither begins with ^ nor ends with $, it may match at any point in
# the incoming character stream.
#
# Deficiencies:
# - no regexps
# - no timeout
# - does not use fileevent nor allow the Tcl event loop to run
#
# Originally written by Stephen Trier and placed in the public domain, March 2003.
#
proc qexpect {channel args} {
#
# Accept both a bracketed list and seperate args
#
if {[llength $args] == 1} {
set args [lindex $args 0]
}
#
# Build the switch statement we will use for matching
#
set sw {}
set eofscript {}
foreach {match script} $args {
switch -- $match {
eof {
set eofscript $script
}
default {
if {[string index $match 0] eq "^"} {
set before {}
set match [string range $match 1 end]
} else {
set before *
}
if {[string index $match end] eq "\$"} {
set after {}
set match [string range $match 0 end-1]
} else {
set after *
}
lappend sw ${before}${match}${after}
lappend sw "return \[uplevel 1 [list $script]\]"
}
}
}
#
# Gather characters from the stream and run them through our
# new switch statement.
#
set text {}
while {1} {
append text [read $channel 1]
switch -glob -- $text $sw
if {[eof $channel]} {
return [uplevel 1 $eofscript]
}
}
}