#!../../tcltk/expect-5.19/expectk -f

# 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:
#############################################
proc tkterm {window task log keep_window } {
    global rows cols tk_version env term \
	term_standout term_spawn_id winval pause

    set pause [ string trim $keep_window ]

    set winval "$window"
    log_file -a -noappend $log
    set tk_version 4.0
    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 0	 ;# if your applications use terminfo
			 ;# (you can use both, but note that
			 ;# starting terminfo is slow)
    set term_shell $task ;# 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 {} {
	global winval pause

	if { [string match "no" $pause ] } {
	    exit
	} else {
	    term_insert "Pausing 10 seconds. Press OUTPUT button in flaunch window for full display."
	    term_update_cursor
	    after 10000 "exit;"
	}
    }
    
    # term_bell is called if the process wants to ring the bell
    if {$tk_version < 4} {
	proc term_bell {} {
	    send_user "\a"
	}
    } else {
	proc term_bell {} {
	    bell
	}
    }

    # 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
    #############################################
    global rows cols

#    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:$oldpath"
    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


if {$tk_version < 4} {
	text $term -relief sunken -bd 1 -width $cols -height $rows
} else {
	# 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
} else {
    pack $term -in $window -side top -fill both
}

$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
		term_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"
	}
}

if {$tk_version < 4} {
    bind $term <Any-KeyPress> {
	if {"%A" != ""} {
		exp_send -i $term_spawn_id -- "%A"
	}
    }
} else {
    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"}

}