# Thterm - terminal emulator using Expect (Allows embedding with Beth)
# Based on Don Libes' tkterm.

###############################
# 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
#   Supports a scrollbar and resize
#   -e <program> runs program instead of SHELL, just like xterm's -e option.
#   Supports xterm's changing window title/iconname hack.
# Good-enough-for-starters attributes:
#   Understands one kind of standout mode (reverse video)
# Soon-to-be-fixed attributes:
#   Better delegation of keybindings between thterm and Beth. (what to do?)
#   Freezes on some Tk manpages (particularly Tk's options(n) page)
# Probably-wont-be-fixed-soon attributes:
#   Underlining via ^H_ doesn't work.
#   Forward-space via <space> doesn't work either. (shows up in tcsh and zsh)
#   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

#############################################
# Variables that must be initialized before using this:
#############################################
set beth_dir "/afs/ece/usr/svoboda/src/beth"	;# Directory for beth source
set rows 24		;# number of rows in term
set cols 80		;# number of columns in term
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)

#############################################
# 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 associated proc exits
proc term_exit {} {
	exit
}

# term_changed is called after every change to the terminal
# 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_changed {} {
}

# Like "term_changed" but only called after data has been changed.
# I.e., if only the cursor is moved, term_data_changed is not called.
proc term_data_changed {} {
}

#############################################
# End of things of interest
#############################################


set env(TERM) "tt"
if $termcap {
    set env(TERMCAP) {tt:
	:cm=\E[%d;%dH:
	:up=\E[A:
	:cl=\E[H\E[J:
	:do=^J:
	:so=\E[7m:
	:se=\E[m:
    }
}

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,
	clear=\E[H\E[J,
	ind=\n,
	cr=\r,
	smso=\E[7m,
	rmso=\E[m,
    }
    close $file
    exec /usr/5bin/tic $ttsrc
    exec rm $ttsrc
}

set term_standout 0	;# if in standout mode or not

log_user 0

wm title . "thTerm"
wm iconname . "thterm"

# Embed Beth or create text/scrollbar widgets.
if {[lindex $argv 0] == "-beth"} {
	set dont_change_title 1
	set option 0
	set configs "[lrange $argv 1 end] -b -w \"-height $rows -width $cols\""
	set argv ""	; set argc 0
	set embedded 1
	set edit_mode 1
	source $beth_dir/beth.tcl
	set term $text		;# name of text widget used by term
	$menu.modules.m entryconfigure "Abbreviation Expansion" -state disabled
	# Remove modified button, we're not interested in it.
	pack forget $frame.fmb $frame.fnl $frame.fpl
} else {
	set embedded 0
	set term .text
	text $term -relief sunken -setgrid true -yscrollcommand {.s set} -height $rows -width $cols
	focus default $term ; 		focus $term
	scrollbar .s -relief raised -command "$term yview"
	pack $term -in . -side right -expand yes -fill both
	pack .s -in . -side right -fill y
}

set index [lsearch $argv "-e"]
if {$index < 0} {
	set term_shell $env(SHELL) ;# program to run in term
} else {set term_shell [lindex $argv [incr index]]
}	

# start a shell and text widget for its output
set rows [lindex [$term configure -height] 4]
set cols [lindex [$term configure -width] 4]
set env(LINES) $rows
set env(COLUMNS) $cols

set stty_init "-tabs"
eval spawn $term_shell
stty rows $rows columns $cols < $spawn_out(slave,name)
set term_spawn_id $spawn_id

$term tag configure standout -underline 1

proc term_clear {} {
	global term

	$term delete 1.0 end
	term_init
}

proc term_init {} {
	global rows cols cur_row cur_col term

	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

	$term insert end \n
	incr cur_row
	if {($cur_row > $rows) && [$term compare "$cur_row.0 -$rows lines" >= @0,0]} {
		$term yview {@0,0 +1 lines}
}}

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]

	##################
	# 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
	}

	set offset "$cur_row.$cur_col + $chars_to_write chars"
	if [$term compare $cur_row.$cur_col != end] {
		if [$term compare $offset >= "$cur_row.0 lineend"] {
			$term delete $cur_row.$cur_col "$cur_row.0 lineend"
		} else {$term delete $cur_row.$cur_col $offset}}

	$term insert $cur_row.$cur_col [
		string range $s 0 [expr $space_rem_on_line-1]
	]

	if {$term_standout} {
		$term tag add standout $cur_row.$cur_col $cur_row.[expr $cur_col + $chars_to_write]
	} else {$term tag remove 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} {

		if [$term compare $cur_row.0 != end] {
			if [$term compare $cur_row.$chars_to_write >= "$cur_row.0 lineend"] {
				$term delete $cur_row.0 "$cur_row.0 lineend"
			} else {$term delete $cur_row.0 $cur_row.$chars_to_write}}

		$term insert $cur_row.0 [string range $s 0 [expr $cols-1]]
		if {$term_standout} {
			$term tag add standout $cur_row.0 "$cur_row.0 lineend"
		}

		# 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} {
		if [$term compare $cur_row.0 != end] {
			$term delete $cur_row.0 $cur_row.$chars_rem_to_write
		}
		$term insert $cur_row.0 $s
		if {$term_standout} {
			$term tag add standout $cur_row.0 $cur_row.$chars_rem_to_write
		} else {$term tag remove standout $cur_row.0 $cur_row.$chars_rem_to_write}

		set cur_col $chars_rem_to_write
	}

	term_changed
}

proc term_update_insert {} {
	global cur_row cur_col term

	$term mark set insert $cur_row.$cur_col

	term_data_changed
}

# Unlike normal paste, this paste sends output to the shell process (which
# should take care of actually pasting text). This paste also filters out
# newlines.
proc paste_to_terminal {} {
	global term expect_out cur_col term_spawn_id

	if {[catch {set chars [$term get sel.first sel.last]}]} {
		if {[catch {set chars [selection get]}]} {
			set chars "" ; puts ""}}

	regsub -all "\n" $chars "" fchars

	exp_send -i $term_spawn_id -- $fchars
	term_update_insert
}

proc terminal_resize {} {
	global rows cols term env spawn_out
	scan [wm geometry .] {%dx%d} new_cols new_rows
	if {($new_rows != $rows) || ($new_cols != $cols)} {
		set rows $new_rows
		set env(LINES) $new_rows
		set cols $new_cols
		set env(COLUMNS) $new_cols
		stty rows $rows columns $cols < $spawn_out(slave,name)
}}


term_init

expect_background {
	-i $term_spawn_id
	-re "^\[^\x01-\x1f]+" {
		# Text
		term_insert $expect_out(0,string)
		term_update_insert
	} "^\r" {
		# (cr,) Go to to beginning of line
		set cur_col 0
		term_update_insert
	} "^\n" {
		# (ind,do) Move cursor down one line
		term_down
		term_update_insert
	} "^\b" {
		# Backspace nondestructively
		incr cur_col -1
		term_update_insert
	} "^\x07" {
		# Bell, pass back to user
		send_user "\x07"
	} "^\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_insert
	} -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_insert
	} "^\x1b\\\[H\x1b\\\[J" {
		# (clear,cl) Clear screen
		term_clear
		term_update_insert
	} "^\x1b\\\[7m" {
		# (smso,so) Begin standout mode
		set term_standout 1
	} "^\x1b\\\[m" {
		# (rmso,se) End standout mode
		set term_standout 0
	} -re "^\x1b\\\](\[0-2\]);(\[^\x01-\x1f\]+)\x07" {
		# Change window/icon title
		set title_no $expect_out(1,string)
		set new_title $expect_out(2,string)
		if {($title_no == 0) || ($title_no == 1)} {
			wm title . $new_title
		}
		if {($title_no == 0) || ($title_no == 2)} {
			wm iconname . $new_title
		}
		term_update_insert
	}
}

bind $term <Meta-Key> {
	if {"%A" != ""} {	
		exp_send -i $term_spawn_id "\033%A"
		$term yview -pickplace insert
	}
}
bind $term <Any-Key> {
	if {"%A" != ""} {
		exp_send -i $term_spawn_id -- "%A"
		$term yview -pickplace insert
	}
}

bind $term <ButtonRelease-3> "paste_to_terminal"
bind all <Configure> "+terminal_resize"

