diff options
Diffstat (limited to 'expect/example/term_expect')
| -rwxr-xr-x | expect/example/term_expect | 488 |
1 files changed, 488 insertions, 0 deletions
diff --git a/expect/example/term_expect b/expect/example/term_expect new file mode 100755 index 00000000000..0b3feda833c --- /dev/null +++ b/expect/example/term_expect @@ -0,0 +1,488 @@ +#!/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... + |