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