1#!../expect -- 2 3# Name: virterm - terminal emulator using Expect, v1.0, December, 1994 4# Author: Adrian Mariano <adrian@cam.cornell.edu> 5# 6# Derived from Done Libes' tkterm 7 8# This is a program for interacting with applications that use terminal 9# control sequences. It is a subset of Don Libes' tkterm emulator 10# with a compatible interface so that programs can be written to work 11# under both. 12# 13# Internally, it uses arrays instead of the Tk widget. Nonetheless, this 14# code is not as fast as it should be. I need an Expect profiler to go 15# any further. 16# 17# standout mode is not supported like it is in tkterm. 18# the only terminal widget operation that is supported for the user 19# is the "get" operation. 20############################################### 21# Variables that must be initialized before using this: 22############################################# 23set rows 24 ;# number of rows in term 24set cols 80 ;# number of columns in term 25set term myterm ;# name of text widget used by term 26set termcap 1 ;# if your applications use termcap 27set terminfo 0 ;# if your applications use terminfo 28 ;# (you can use both, but note that 29 ;# starting terminfo is slow) 30set term_shell $env(SHELL) ;# program to run in term 31 32############################################# 33# Readable variables of interest 34############################################# 35# cur_row ;# current row where insert marker is 36# cur_col ;# current col where insert marker is 37# term_spawn_id ;# spawn id of term 38 39############################################# 40# Procs you may want to initialize before using this: 41############################################# 42 43# term_exit is called if the associated proc exits 44proc term_exit {} { 45 exit 46} 47 48# term_chars_changed is called after every change to the displayed chars 49# You can use if you want matches to occur in the background (a la bind) 50# If you want to test synchronously, then just do so - you don't need to 51# redefine this procedure. 52proc term_chars_changed {} { 53} 54 55# term_cursor_changed is called after the cursor is moved 56proc term_cursor_changed {} { 57} 58 59# Example tests you can make 60# 61# Test if cursor is at some specific location 62# if {$cur_row == 1 && $cur_col == 0} ... 63# 64# Test if "foo" exists anywhere in line 4 65# if {[string match *foo* [$term get 4.0 4.end]]} 66# 67# Test if "foo" exists at line 4 col 7 68# if {[string match foo* [$term get 4.7 4.end]]} 69# 70# Return contents of screen 71# $term get 1.0 end 72 73############################################# 74# End of things of interest 75############################################# 76 77set blankline "" 78set env(LINES) $rows 79set env(COLUMNS) $cols 80 81set env(TERM) "tt" 82if {$termcap} { 83 set env(TERMCAP) {tt: 84 :cm=\E[%d;%dH: 85 :up=\E[A: 86 :cl=\E[H\E[J: 87 :do=^J: 88 :so=\E[7m: 89 :se=\E[m: 90 :nd=\E[C: 91 } 92} 93 94if {$terminfo} { 95 set env(TERMINFO) /tmp 96 set ttsrc "/tmp/tt.src" 97 set file [open $ttsrc w] 98 99 puts $file {tt|textterm|Don Libes' tk text widget terminal emulator, 100 cup=\E[%p1%d;%p2%dH, 101 cuu1=\E[A, 102 cuf1=\E[C, 103 clear=\E[H\E[J, 104 ind=\n, 105 cr=\r, 106 smso=\E[7m, 107 rmso=\E[m, 108 } 109 close $file 110 111 set oldpath $env(PATH) 112 set env(PATH) "/usr/5bin:/usr/lib/terminfo" 113 if {1==[catch {exec tic $ttsrc} msg]} { 114 puts "WARNING: tic failed - if you don't have terminfo support on" 115 puts "your system, change \"set terminfo 1\" to \"set terminfo 0\"." 116 puts "Here is the original error from running tic:" 117 puts $msg 118 } 119 set env(PATH) $oldpath 120 121 exec rm $ttsrc 122} 123 124log_user 0 125 126# start a shell and text widget for its output 127set stty_init "-tabs" 128eval spawn $term_shell 129stty rows $rows columns $cols < $spawn_out(slave,name) 130set term_spawn_id $spawn_id 131 132proc term_replace {reprow repcol text} { 133 global termdata 134 set middle $termdata($reprow) 135 set termdata($reprow) \ 136 [string range $middle 0 [expr $repcol-1]]$text[string \ 137 range $middle [expr $repcol+[string length $text]] end] 138} 139 140 141proc parseloc {input row col} { 142 upvar $row r $col c 143 global rows 144 switch -glob -- $input \ 145 end { set r $rows; set c end } \ 146 *.* { regexp (.*)\\.(.*) $input dummy r c 147 if {$r == "end"} { set r $rows } 148 } 149} 150 151proc myterm {command first second args} { 152 global termdata 153 if {[string compare get $command]} { 154 send_error "Unknown terminal command: $command\r" 155 } else { 156 parseloc $first startrow startcol 157 parseloc $second endrow endcol 158 if {$endcol != "end"} {incr endcol -1} 159 if {$startrow == $endrow} { 160 set data [string range $termdata($startrow) $startcol $endcol] 161 } else { 162 set data [string range $termdata($startrow) $startcol end] 163 for {set i [expr $startrow + 1]} {$i < $endrow} {incr i} { 164 append data $termdata($i) 165 } 166 append data [string range $termdata($endrow) 0 $endcol] 167 } 168 return $data 169 } 170} 171 172 173proc scrollup {} { 174 global termdata blankline 175 for {set i 1} {$i < $rows} {incr i} { 176 set termdata($i) $termdata([expr $i+1]) 177 } 178 set termdata($rows) $blankline 179} 180 181 182proc term_init {} { 183 global rows cols cur_row cur_col term termdata blankline 184 185 # initialize it with blanks to make insertions later more easily 186 set blankline [format %*s $cols ""]\n 187 for {set i 1} {$i <= $rows} {incr i} { 188 set termdata($i) "$blankline" 189 } 190 191 set cur_row 1 192 set cur_col 0 193} 194 195 196proc term_down {} { 197 global cur_row rows cols term 198 199 if {$cur_row < $rows} { 200 incr cur_row 201 } else { 202 scrollup 203 } 204} 205 206 207proc term_insert {s} { 208 global cols cur_col cur_row term 209 210 set chars_rem_to_write [string length $s] 211 set space_rem_on_line [expr $cols - $cur_col] 212 213 ################## 214 # write first line 215 ################## 216 217 if {$chars_rem_to_write <= $space_rem_on_line} { 218 term_replace $cur_row $cur_col \ 219 [string range $s 0 [expr $space_rem_on_line-1]] 220 incr cur_col $chars_rem_to_write 221 term_chars_changed 222 return 223 } 224 225 set chars_to_write $space_rem_on_line 226 set newline 1 227 228 term_replace $cur_row $cur_col\ 229 [string range $s 0 [expr $space_rem_on_line-1]] 230 231 # discard first line already written 232 incr chars_rem_to_write -$chars_to_write 233 set s [string range $s $chars_to_write end] 234 235 # update cur_col 236 incr cur_col $chars_to_write 237 # update cur_row 238 if {$newline} { 239 term_down 240 } 241 242 ################## 243 # write full lines 244 ################## 245 while {$chars_rem_to_write >= $cols} { 246 term_replace $cur_row 0 [string range $s 0 [expr $cols-1]] 247 248 # discard line from buffer 249 set s [string range $s $cols end] 250 incr chars_rem_to_write -$cols 251 252 set cur_col 0 253 term_down 254 } 255 256 ################# 257 # write last line 258 ################# 259 260 if {$chars_rem_to_write} { 261 term_replace $cur_row 0 $s 262 set cur_col $chars_rem_to_write 263 } 264 265 term_chars_changed 266} 267 268term_init 269 270expect_before { 271 -i $term_spawn_id 272 -re "^\[^\x01-\x1f]+" { 273 # Text 274 term_insert $expect_out(0,string) 275 term_cursor_changed 276 } "^\r" { 277 # (cr,) Go to to beginning of line 278 set cur_col 0 279 term_cursor_changed 280 } "^\n" { 281 # (ind,do) Move cursor down one line 282 term_down 283 term_cursor_changed 284 } "^\b" { 285 # Backspace nondestructively 286 incr cur_col -1 287 term_cursor_changed 288 } "^\a" { 289 # Bell, pass back to user 290 send_user "\a" 291 } "^\t" { 292 # Tab, shouldn't happen 293 send_error "got a tab!?" 294 } eof { 295 term_exit 296 } "^\x1b\\\[A" { 297 # (cuu1,up) Move cursor up one line 298 incr cur_row -1 299 term_cursor_changed 300 } "^\x1b\\\[C" { 301 # (cuf1,nd) Nondestructive space 302 incr cur_col 303 term_cursor_changed 304 } -re "^\x1b\\\[(\[0-9]*);(\[0-9]*)H" { 305 # (cup,cm) Move to row y col x 306 set cur_row [expr $expect_out(1,string)+1] 307 set cur_col $expect_out(2,string) 308 term_cursor_changed 309 } "^\x1b\\\[H\x1b\\\[J" { 310 # (clear,cl) Clear screen 311 term_init 312 term_cursor_changed 313 } "^\x1b\\\[7m" { # unsupported 314 # (smso,so) Begin standout mode 315 # set term_standout 1 316 } "^\x1b\\\[m" { # unsupported 317 # (rmso,se) End standout mode 318 # set term_standout 0 319 } 320} 321 322 323proc term_expect {args} { 324 global cur_row cur_col # used by expect_background actions 325 326 set desired_timeout [ 327 uplevel { 328 if {[info exists timeout]} { 329 set timeout 330 } else { 331 uplevel #0 { 332 if {[info exists timeout]} { 333 set timeout 334 } else { 335 expr 10 336 } 337 } 338 } 339 } 340 ] 341 342 set timeout $desired_timeout 343 344 set timeout_act {} 345 346 set argc [llength $args] 347 if {$argc%2 == 1} { 348 lappend args {} 349 incr argc 350 } 351 352 for {set i 0} {$i<$argc} {incr i 2} { 353 set act_index [expr $i+1] 354 if {[string compare timeout [lindex $args $i]] == 0} { 355 set timeout_act [lindex $args $act_index] 356 set args [lreplace $args $i $act_index] 357 incr argc -2 358 break 359 } 360 } 361 362 set got_timeout 0 363 364 set start_time [timestamp] 365 366 while {![info exists act]} { 367 expect timeout {set got_timeout 1} 368 set timeout [expr $desired_timeout - [timestamp] + $start_time] 369 if {! $got_timeout} \ 370 { 371 for {set i 0} {$i<$argc} {incr i 2} { 372 if {[uplevel [lindex $args $i]]} { 373 set act [lindex $args [incr i]] 374 break 375 } 376 } 377 } else { set act $timeout_act } 378 379 if {![info exists act]} { 380 381 } 382 } 383 384 set code [catch {uplevel $act} string] 385 if {$code > 4} {return -code $code $string} 386 if {$code == 4} {return -code continue} 387 if {$code == 3} {return -code break} 388 if {$code == 2} {return -code return} 389 if {$code == 1} {return -code error -errorinfo $errorInfo \ 390 -errorcode $errorCode $string} 391 return $string 392} 393 394 395# ======= end of terminal emulator ======== 396 397# The following is a program to interact with the Cornell Library catalog 398 399 400proc waitfornext {} { 401 global cur_row cur_col term 402 term_expect {expr {$cur_col==15 && $cur_row == 24 && 403 " NEXT COMMAND: " == [$term get 24.0 24.16]}} {} 404} 405 406proc sendcommand {command} { 407 global cur_col 408 exp_send $command 409 term_expect {expr {$cur_col == 79}} {} 410} 411 412proc removespaces {intext} { 413 regsub -all " *\n" $intext \n intext 414 regsub "\n+$" $intext \n intext 415 return $intext 416} 417 418proc output {text} { 419 exp_send_user $text 420} 421 422 423 424proc connect {} { 425 global term 426 term_expect {regexp {.*[>%]} [$term get 1.0 3.end]} 427 exp_send "tn3270 notis.library.cornell.edu\r" 428 term_expect {regexp "desk" [$term get 19.0 19.end]} { 429 exp_send "\r" 430 } 431 waitfornext 432 exp_send_error "connected.\n\n" 433} 434 435 436proc dosearch {search} { 437 global term 438 exp_send_error "Searching for '$search'..." 439 if {[string match ?=* "$search"]} {set typ ""} else {set typ "k="} 440 sendcommand "$typ$search\r" 441 waitfornext 442 set countstr [$term get 2.17 2.35] 443 if {![regsub { Entries Found *} $countstr "" number]} { 444 set number 1 445 exp_send_error "one entry found.\n\n" 446 return 1 447 } 448 if {$number == 0} { 449 exp_send_error "no matches.\n\n" 450 return 0 451 } 452 exp_send_error "$number entries found.\n" 453 if {$number > 250} { 454 exp_send_error "(only the first 250 can be displayed)\n" 455 } 456 exp_send_error "\n" 457 return $number 458} 459 460 461proc getshort {count} { 462 global term 463 output [removespaces [$term get 5.0 19.0]] 464 while {[regexp "CONTINUED on next page" [$term get 19.0 19.end]]} { 465 sendcommand "for\r" 466 waitfornext 467 output [removespaces [$term get 5.0 19.0]] 468 } 469} 470 471proc getonecitation {} { 472 global term 473 output [removespaces [$term get 4.0 19.0]] 474 while {[regexp "FORward page" [$term get 20.0 20.end]]} { 475 sendcommand "for\r" 476 waitfornext 477 output [removespaces [$term get 5.0 19.0]] 478 } 479} 480 481 482proc getcitlist {} { 483 global term 484 getonecitation 485 set citcount 1 486 while {[regexp "NEXt record" [$term get 20.0 21.end]]} { 487 sendcommand "nex\r" 488 waitfornext 489 getonecitation 490 incr citcount 491 if {$citcount % 10 == 0} {exp_send_error "$citcount.."} 492 } 493} 494 495proc getlong {count} { 496 if {$count != 1} { 497 sendcommand "1\r" 498 waitfornext 499 } 500 sendcommand "lon\r" 501 waitfornext 502 getcitlist 503} 504 505proc getmed {count} { 506 if {$count != 1} { 507 sendcommand "1\r" 508 waitfornext 509 } 510 sendcommand "bri\r" 511 waitfornext 512 getcitlist 513} 514 515################################################################# 516# 517set help { 518libsearch version 1.0 by Adrian Mariano (adrian@cam.cornell.edu) 519 520Invocation: libsearch [options] search text 521 522 -i : interactive 523 -s : short listing 524 -l : long listing 525 -o file : output file (default stdout) 526 -h : print out list of options and version number 527 -H : print terse keyword search help 528 529The search will be a keyword search. 530Example: libsearch -i sound and arabic 531 532} 533 534################################################################# 535 536proc searchhelp {} { 537 send_error { 538? truncation wildcard default operator is AND 539 540AND - both words appear in record 541OR - one of the words appears 542NOT - first word appears, second words does not 543ADJ - words are adjacent 544SAME- words appear in the same field (any order) 545 546.su. - subject b.fmt. - books eng.lng. - English 547.ti. - title m.fmt. - music spa.lng. - Spanish 548.au. - author s.fmt. - serials fre.lng. - French 549 550.dt. or .dt1. -- limits to a specific publication year. E.g., 1990.dt. 551 552} 553} 554 555proc promptuser {prompt} { 556 exp_send_error "$prompt" 557 expect_user -re "(.*)\n" 558 return "$expect_out(1,string)" 559} 560 561 562set searchtype 1 563set outfile "" 564set search "" 565set interactive 0 566 567while {[llength $argv]>0} { 568 set flag [lindex $argv 0] 569 switch -glob -- $flag \ 570 "-i" { set interactive 1; set argv [lrange $argv 1 end]} \ 571 "-s" { set searchtype 0; set argv [lrange $argv 1 end] } \ 572 "-l" { set searchtype 2; set argv [lrange $argv 1 end] } \ 573 "-o" { set outfile [lindex $argv 1]; set argv [lrange $argv 2 end] } \ 574 "-H" { searchhelp; exit } \ 575 "-h" { send_error "$help"; exit } \ 576 "-*" { send_error "\nUnknown option: $flag\n$help";exit }\ 577 default { set search [join $argv]; set argv {};} 578} 579if { "$search" == "" } { 580 send_error "No search specified\n$help" 581 exit 582} 583 584exp_send_error "Connecting to the library..." 585 586set timeout 200 587 588trap { log_user 1;exp_send "\003"; 589 expect_before 590 expect tn3270 {exp_send "quit\r"} 591 expect "Connection closed." {exp_send "exit\r"} 592 expect eof ; send_error "\n"; 593 exit} SIGINT 594 595 596connect 597 598set result [dosearch $search] 599 600if {$interactive} { 601 set quit 0 602 while {!$quit} { 603 if {!$result} { 604 switch "[promptuser {(h)elp (n)ewsearch (q)uit? }]" { 605 n { } 606 h { searchhelp } 607 q { set quit 1} 608 } 609 } else { 610 switch "[promptuser {(s)hort (m)ed (l)ong (h)elp (n)ewsearch (q)uit? }]" { 611 s { getshort $result; ;} 612 l { getlong $result; ;} 613 m { getmed $result; ; } 614 n { research; } 615 h { searchhelp } 616 q { set quit 1; } 617 } 618 } 619 } 620} else { 621 if {$result} { 622 switch $searchtype { 623 0 { getshort $result} 624 1 { getmed $result } 625 2 { getlong $result } 626 } 627 } 628} 629 630 631 632 633 634 635