#!/usr/local/bin/expectk --
# Name: tkterm - terminal emulator using Expect and Tk text widget, v1.0
# Author: Don Libes, July '94
# This is primarily for regression testing character-graphic applications.
# You can certainly use it as a terminal emulator - however many features
# in a real terminal emulator are not supported (although I'll probably
# add some of them later).
###############################
# Quick overview of this emulator
###############################
# Very good attributes:
# Understands both termcap and terminfo
# Understands meta-key (zsh, emacs, etc work)
# Is fast
# Understands X selections
# Looks best with fixed-width font but doesn't require it
# Good-enough-for-starters attributes:
# Understands one kind of standout mode (reverse video)
# Should-be-fixed-soon attributes:
# Does not support scrollbar or resize
# Probably-wont-be-fixed-soon attributes:
# Assumes only one terminal exists
###############################################
# To try out this package, just run it. Using it in
# your scripts is simple. Here are directions:
###############################################
# 0) make sure Expect is linked into your Tk-based program (or vice versa)
# 1) modify the variables/procedures below these comments appropriately
# 2) source this file
# 3) pack the text widget ($term) if you have so configured it (see
# "term_alone" below). As distributed, it packs into . automatically.
#############################################
# Variables that must be initialized before using this:
#############################################
set rows 24 ;# number of rows in term
set cols 80 ;# number of columns in term
set term .t ;# name of text widget used by term
set term_alone 1 ;# if 1, directly pack term into .
;# else you must pack
set termcap 1 ;# if your applications use termcap
set terminfo 1 ;# if your applications use terminfo
;# (you can use both, but note that
;# starting terminfo is slow)
set term_shell $env(SHELL) ;# program to run in term
#############################################
# Readable variables of interest
#############################################
# cur_row ;# current row where insert marker is
# cur_col ;# current col where insert marker is
# term_spawn_id ;# spawn id of term
#############################################
# Procs you may want to initialize before using this:
#############################################
# term_exit is called if the spawned process exits
proc term_exit {} {
exit
}
# term_chars_changed is called after every change to the displayed chars
# You can use if you want matches to occur in the background (a la bind)
# If you want to test synchronously, then just do so - you don't need to
# redefine this procedure.
proc term_chars_changed {} {
}
# term_cursor_changed is called after the cursor is moved
proc term_cursor_changed {} {
}
# Example tests you can make
#
# Test if cursor is at some specific location
# if {$cur_row == 1 && $cur_col == 0} ...
#
# Test if "foo" exists anywhere in line 4
# if {[string match *foo* [$term get 4.0 4.end]]}
#
# Test if "foo" exists at line 4 col 7
# if {[string match foo* [$term get 4.7 4.end]]}
#
# Test if a specific character at row 4 col 5 is in standout
# if {-1 != [lsearch [$term tag names 4.5] standout]} ...
#
# Return contents of screen
# $term get 1.0 end
#
# Return indices of first string on lines 4 to 6 that is in standout mode
# $term tag nextrange standout 4.0 6.end
#
# Replace all occurrences of "foo" with "bar" on screen
# for {set i 1} {$i<=$rows} {incr i} {
# regsub -all "foo" [$term get $i.0 $i.end] "bar" x
# $term delete $i.0 $i.end
# $term insert $i.0 $x
# }
#############################################
# End of things of interest
#############################################
unset env(DISPLAY)
set env(LINES) $rows
set env(COLUMNS) $cols
set env(TERM) "tt"
if $termcap {
set env(TERMCAP) {tt:
:cm=\E[%d;%dH:
:up=\E[A:
:nd=\E[C:
:cl=\E[H\E[J:
:do=^J:
:so=\E[7m:
:se=\E[m:
:k1=\EOP:
:k2=\EOQ:
:k3=\EOR:
:k4=\EOS:
:k5=\EOT:
:k6=\EOU:
:k7=\EOV:
:k8=\EOW:
:k9=\EOX:
}
}
if $terminfo {
set env(TERMINFO) /tmp
set ttsrc "/tmp/tt.src"
set file [open $ttsrc w]
puts $file {tt|textterm|Don Libes' tk text widget terminal emulator,
cup=\E[%p1%d;%p2%dH,
cuu1=\E[A,
cuf1=\E[C,
clear=\E[H\E[J,
ind=\n,
cr=\r,
smso=\E[7m,
rmso=\E[m,
kf1=\EOP,
kf2=\EOQ,
kf3=\EOR,
kf4=\EOS,
kf5=\EOT,
kf6=\EOU,
kf7=\EOV,
kf8=\EOW,
kf9=\EOX,
}
close $file
set oldpath $env(PATH)
set env(PATH) "/usr/5bin:/usr/lib/terminfo"
if 1==[catch {exec tic $ttsrc} msg] {
puts "WARNING: tic failed - if you don't have terminfo support on"
puts "your system, change \"set terminfo 1\" to \"set terminfo 0\"."
puts "Here is the original error from running tic:"
puts $msg
}
set env(PATH) $oldpath
exec rm $ttsrc
}
set term_standout 0 ;# if in standout mode or not
log_user 0
# start a shell and text widget for its output
set stty_init "-tabs"
eval spawn $term_shell
stty rows $rows columns $cols < $spawn_out(slave,name)
set term_spawn_id $spawn_id
# this shouldn't be needed if Ousterhout fixes text bug
text $term -relief sunken -bd 1 -width $cols -height $rows -wrap none
if {$term_alone} {
pack $term
}
$term tag configure standout -background black -foreground white
proc term_clear {} {
global term
$term delete 1.0 end
term_init
}
proc term_init {} {
global rows cols cur_row cur_col term
# initialize it with blanks to make insertions later more easily
set blankline [format %*s $cols ""]\n
for {set i 1} {$i <= $rows} {incr i} {
$term insert $i.0 $blankline
}
set cur_row 1
set cur_col 0
$term mark set insert $cur_row.$cur_col
}
proc term_down {} {
global cur_row rows cols term
if {$cur_row < $rows} {
incr cur_row
} else {
# already at last line of term, so scroll screen up
$term delete 1.0 "1.end + 1 chars"
# recreate line at end
$term insert end [format %*s $cols ""]\n
}
}
proc term_insert {s} {
global cols cur_col cur_row
global term term_standout
set chars_rem_to_write [string length $s]
set space_rem_on_line [expr $cols - $cur_col]
if {$term_standout} {
set tag_action "add"
} else {
set tag_action "remove"
}
##################
# write first line
##################
if {$chars_rem_to_write > $space_rem_on_line} {
set chars_to_write $space_rem_on_line
set newline 1
} else {
set chars_to_write $chars_rem_to_write
set newline 0
}
$term delete $cur_row.$cur_col $cur_row.[expr $cur_col + $chars_to_write]
$term insert $cur_row.$cur_col [
string range $s 0 [expr $space_rem_on_line-1]
]
$term tag $tag_action standout $cur_row.$cur_col $cur_row.[expr $cur_col + $chars_to_write]
# discard first line already written
incr chars_rem_to_write -$chars_to_write
set s [string range $s $chars_to_write end]
# update cur_col
incr cur_col $chars_to_write
# update cur_row
if $newline {
term_down
}
##################
# write full lines
##################
while {$chars_rem_to_write >= $cols} {
$term delete $cur_row.0 $cur_row.end
$term insert $cur_row.0 [string range $s 0 [expr $cols-1]]
$term tag $tag_action standout $cur_row.0 $cur_row.end
# discard line from buffer
set s [string range $s $cols end]
incr chars_rem_to_write -$cols
set cur_col 0
term_down
}
#################
# write last line
#################
if {$chars_rem_to_write} {
$term delete $cur_row.0 $cur_row.$chars_rem_to_write
$term insert $cur_row.0 $s
$term tag $tag_action standout $cur_row.0 $cur_row.$chars_rem_to_write
set cur_col $chars_rem_to_write
}
term_chars_changed
}
proc term_update_cursor {} {
global cur_row cur_col term
$term mark set insert $cur_row.$cur_col
term_cursor_changed
}
term_init
expect_background {
-i $term_spawn_id
-re "^\[^\x01-\x1f]+" {
# Text
term_insert $expect_out(0,string)
term_update_cursor
} "^\r" {
# (cr,) Go to beginning of line
set cur_col 0
term_update_cursor
} "^\n" {
# (ind,do) Move cursor down one line
term_down
term_update_cursor
} "^\b" {
# Backspace nondestructively
incr cur_col -1
term_update_cursor
} "^\a" {
bell
} "^\t" {
# Tab, shouldn't happen
send_error "got a tab!?"
} eof {
term_exit
} "^\x1b\\\[A" {
# (cuu1,up) Move cursor up one line
incr cur_row -1
term_update_cursor
} "^\x1b\\\[C" {
# (cuf1,nd) Non-destructive space
incr cur_col
term_update_cursor
} -re "^\x1b\\\[(\[0-9]*);(\[0-9]*)H" {
# (cup,cm) Move to row y col x
set cur_row [expr $expect_out(1,string)+1]
set cur_col $expect_out(2,string)
term_update_cursor
} "^\x1b\\\[H\x1b\\\[J" {
# (clear,cl) Clear screen
term_clear
term_update_cursor
} "^\x1b\\\[7m" {
# (smso,so) Begin standout mode
set term_standout 1
} "^\x1b\\\[m" {
# (rmso,se) End standout mode
set term_standout 0
}
}
bind $term <Any-Enter> {
focus %W
}
bind $term <Meta-KeyPress> {
if {"%A" != ""} {
exp_send -i $term_spawn_id "\033%A"
}
}
bind $term <KeyPress> {
exp_send -i $term_spawn_id -- %A
break
}
bind $term <Control-space> {exp_send -null}
bind $term <Control-at> {exp_send -null}
bind $term <F1> {exp_send -i $term_spawn_id "\033OP"}
bind $term <F2> {exp_send -i $term_spawn_id "\033OQ"}
bind $term <F3> {exp_send -i $term_spawn_id "\033OR"}
bind $term <F4> {exp_send -i $term_spawn_id "\033OS"}
bind $term <F5> {exp_send -i $term_spawn_id "\033OT"}
bind $term <F6> {exp_send -i $term_spawn_id "\033OU"}
bind $term <F7> {exp_send -i $term_spawn_id "\033OV"}
bind $term <F8> {exp_send -i $term_spawn_id "\033OW"}
bind $term <F9> {exp_send -i $term_spawn_id "\033OX"}
set term_counter 0
proc term_expect {args} {
upvar timeout localTimeout
upvar #0 timeout globalTimeout
set timeout 10
catch {set timeout $globalTimeout}
catch {set timeout $localTimeout}
global term_counter
incr term_counter
global [set strobe _data_[set term_counter]]
global [set tstrobe _timer_[set term_counter]]
proc term_chars_changed {} "uplevel #0 set $strobe 1"
set $strobe 1
set $tstrobe 0
if {$timeout >= 0} {
set mstimeout [expr 1000*$timeout]
after $mstimeout "set $strobe 1; set $tstrobe 1"
set timeout_act {}
}
set argc [llength $args]
if {$argc%2 == 1} {
lappend args {}
incr argc
}
for {set i 0} {$i<$argc} {incr i 2} {
set act_index [expr $i+1]
if {[string compare timeout [lindex $args $i]] == 0} {
set timeout_act [lindex $args $act_index]
set args [lreplace $args $i $act_index]
incr argc -2
break
}
}
while {![info exists act]} {
if {![set $strobe]} {
tkwait var $strobe
}
set $strobe 0
if {[set $tstrobe]} {
set act $timeout_act
} else {
for {set i 0} {$i<$argc} {incr i 2} {
if {[uplevel [lindex $args $i]]} {
set act [lindex $args [incr i]]
break
}
}
}
}
proc term_chars_changed {} {}
if {$timeout >= 0} {
after $mstimeout unset $strobe $tstrobe
} else {
unset $strobe $tstrobe
}
set code [catch {uplevel $act} string]
if {$code > 4} {return -code $code $string}
if {$code == 4} {return -code continue}
if {$code == 3} {return -code break}
if {$code == 2} {return -code return}
if {$code == 1} {return -code error -errorinfo $errorInfo \
-errorcode $errorCode $string}
return $string
}
##################################################
# user-supplied code goes below here
##################################################
set timeout 200
# for example, wait for a shell prompt
term_expect {regexp "%" [$term get 1.0 3.end]}
# invoke game of rogue
exp_send "myrogue\r"
# wait for strength of 18
term_expect \
{regexp "Str: 18" [$term get 24.0 24.end]} {
# do something
} {timeout} {
puts "ulp...timed out!"
} {regexp "Str: 16" [$term get 24.0 24.end]}
# and so on...