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 command for a send-expect interface would make my life simpler.
Therefore, I used the expect man page to inspire the following "quickie" rendition of something expect-like in pure Tcl. It operates on any 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 a "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.
#
# 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.
#
# This should be made fileevent-based.
#
set text {}
while {1} {
append text [read $channel 1]
switch -glob -- $text $sw
if {[eof $channel]} {
return [uplevel 1 $eofscript]
}
}
}