# Thterm - terminal emulator using Expectk
# Based on Don Libes' tkterm.
# Has a few Teacher Hypertool enhancements (see end of code) plus a few general
# extras

# Can take two arguments: -e <program> runs program, instead of standard shell,
# just like xterm. -a means don't add Teacher Hypertools options.

###############################
# Quick overview of this emulator
###############################
# Very good attributes:
#   Understands both termcap and terminfo   
#   Understands meta-key (zsh, emacs, etc work)
#   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)
#   Is fast (well, not as fast as xterm, but OK)
# 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 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"
frame .f ; pack .f -expand yes -fill both

set term .f.t
text $term -relief sunken -setgrid true -yscrollcommand {.f.s set} \
	-height $rows -width $cols
focus default $term ;     focus $term
scrollbar .f.s -relief raised -command "$term yview"
pack $term -side right -expand yes -fill both
pack .f.s -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
  } "*" {
    # We don't know what this is.
    send_error "Unknown: '$expect_out(0,string)'"
    term_insert $expect_out(0,string)
    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"


### Teacher Hypertool enhancements

# Embed some Elsbeth functions into text widget
# (Actually, this is a subset of the hypertools provided, elsbeth has nothing
# to do with this code.)
if {[lsearch $argv "-a"] < 0} {
cd [file dirname [info script]]/../lib
set auto_path "[pwd] $auto_path"

foreach th_binding {<Meta-n> <Next>} {
 bind Entry $th_binding {if {[catch {focus [th_next_widget %W]}]} {focus [th_next_widget . [winfo class %W]]}}}
foreach th_binding {<Meta-p> <Prior>} {
 bind Entry $th_binding {if {[catch {focus [th_previous_widget %W]}]} {focus [th_previous_widget . [winfo class %W]]}}}
bind Entry <Escape> {if {[catch {focus [th_next_widget %W]}]} {focus [th_previous_widget %W Text]}}
foreach th_binding {<Meta-z> <Up> <Left>} {
 bind Entry $th_binding {th_Entry_scroll %W [expr [%W index @0] -1]}}
foreach th_binding {<Control-z> <Down> <Right>} {
 bind Entry $th_binding {th_Entry_scroll %W [expr [%W index @0] +1]}}
foreach th_binding {<Meta-v> <Shift-Up> <Shift-Left>} {
 bind Entry $th_binding {th_Entry_scroll %W [expr [%W index @0] - [lindex [%W configure -width] 4] + 1]}}
foreach th_binding {<Control-v> <Shift-Down> <Shift-Right>} {
 bind Entry $th_binding {th_Entry_scroll %W [expr [%W index @0] + [lindex [%W configure -width] 4] - 1]}}
foreach th_binding {<Control-b> <Left>} {
 bind Entry $th_binding {th_Entry_goto %W [expr [%W index insert] - 1]}}
foreach th_binding {<Control-f> <Right>} {
 bind Entry $th_binding {th_Entry_goto %W [expr [%W index insert] + 1]}}
bind Entry <Meta-b> {th_Entry_goto %W [th_string_wordstart [%W get] [expr [%W index insert] -1]]}
bind Entry <Meta-f> {th_Entry_goto %W [th_string_wordend [%W get] [%W index insert]]}
bind Entry <Control-a> {th_Entry_goto %W @0}
bind Entry <Control-e> {th_Entry_goto %W [expr [%W index @0] + [lindex [%W configure -width] 4] - 1]}
foreach th_binding {<Meta-less> <Control-Up> <Control-Left>} {
 bind Entry $th_binding {th_Entry_goto %W 0 0}}
foreach th_binding {<Meta-greater> <Control-Down> <Control-Right>} {
 bind Entry $th_binding {th_Entry_goto %W end 0}}
bind Entry <Control-l> {th_Entry_scroll %W [expr [%W index insert] - [lindex [%W configure -width] 4] / 2]}
bind Entry <Control-L> {th_Entry_goto %W [expr [%W index @0] + ([lindex [%W configure -width] 4] / 2)]}
foreach th_binding {<Control-K> <Control-k> <Select>} {
 bind Entry $th_binding {th_Entry_select_next_line %W}}
foreach th_binding {<Control-W> <Control-w> <Control-Select>} {
 bind Entry $th_binding {th_Entry_select_region %W}}
foreach th_binding {<Meta-w> <Meta-Select>} {
 bind Entry $th_binding {%W select from 0 ; %W select to end}}
foreach th_binding {<Control-c> <Shift-Select>} {
 bind Entry $th_binding {%W select from 0 ; %W select to end ; %W select clear}}
bind Entry <Control-x> {th_Entry_exchange_mark %W}
bind Entry <Control-space> {set TH(Mark,%W) [%W index insert]}
bind Entry <Meta-g> {th_goto %W}
bind Entry <Control-g> {th_beep}
bind Entry <Meta-Control-u> {th_[winfo class %W]_undo %W}
bind Entry <Meta-Control-l> {th_look_undo %W}
bind Entry <Meta-Control-k> {th_kill_undos %W}
foreach th_binding {<Control-y> <Insert> <ButtonRelease-3>} {
 bind Entry $th_binding {th_[winfo class %W]_paste_selection %W}}
bind Entry <Control-q> {th_quote %W}
bind Entry <Control-k> {th_[winfo class %W]_kill_line %W}
bind Entry <Control-w> {th_[winfo class %W]_kill_region %W}
foreach th_binding {<Control-Delete> <Button1-Delete>} {
 bind Entry $th_binding {th_[winfo class %W]_delete_selection %W}}
bind Entry <Meta-u> {th_[winfo class %W]_filter %W th_string_toupper}
bind Entry <Meta-l> {th_[winfo class %W]_filter %W th_string_tolower}
bind Entry <Meta-c> {th_[winfo class %W]_filter %W th_string_capitalize}
bind Entry <Control-t> {th_[winfo class %W]_transpose_chars %W}
bind Entry <Control-u> {%W icursor 0 ; th_Entry_kill_line %W}
foreach th_binding {<Control-h> <Delete>} {
 bind Entry $th_binding {th_[winfo class %W]_delete_char_backward %W}}
foreach th_binding {<Control-d> <Shift-Delete>} {
 bind Entry $th_binding {th_[winfo class %W]_delete_char_forward %W}}
foreach th_binding {<Meta-h> <Meta-Delete>} {
 bind Entry $th_binding {th_[winfo class %W]_delete_word_backward %W}}
foreach th_binding {<Meta-d> <Meta-Shift-Delete>} {
 bind Entry $th_binding {th_[winfo class %W]_delete_word_forward %W}}
bind Entry <Meta-t> {th_[winfo class %W]_transpose_words %W}
bind Entry <Meta-o> {th_checkbutton_variable Overwrite,%W}
bind Entry <Key> {th_[winfo class %W]_self_insert %W %A}
foreach th_binding {<Control-bracketright> <Meta-Shift-Left>} {
 bind Entry $th_binding {th_resize_widget %W -width -1}}
foreach th_binding {<Control-braceright> <Meta-Shift-Right>} {
 bind Entry $th_binding {th_resize_widget %W -width +1}}
bind Entry <Tab> {if {![th_[winfo class %W]_complete_multiple %W {{th_substring_replace th_string_tcl_result {[}} {th_substring_replace th_string_global_value {$}} {th_substring_replace th_string_glob_files { }} {th_substring_complete th_filter_cmds {[}} {th_substring_complete th_filter_vars {$}} {th_substring_complete th_filter_glob { }}}]} {catch {th_[winfo class %W]_self_insert %W %A}}}
bind Entry <Control-Tab> {th_[winfo class %W]_completion_dialog %W}

frame .f.t_mb
pack .f.t_mb -f x -before .f.t -side top -anchor e

# Search options
set TH(Binding,OK) {<Return> <Control-m> <Key-KP_Enter>}
set TH(Binding,Cancel) {<Control-g>}
set TH(Binding,Search_Forward) {<Control-s> <Find>}
set TH(Binding,Search_Backward) {<Control-r> <Control-Find>}
set TH(Binding,Toggle_Case_Sensitivity) {<Meta-Control-c>}
set TH(Binding,Toggle_Incremental_Search) {<Meta-Control-n>}
set TH(Search,Select,Text) sel
set TH(Search,Text,Oldtag) {-background yellow4 -foreground white}
set TH(Binding,Highlight_Searches) {<Meta-Control-h>}

menubutton .f.t_mb.search -m .f.t_mb.search.m -text Search -u 0
pack .f.t_mb.search -in .f.t_mb -side left
menu .f.t_mb.search.m
.f.t_mb.search.m add cascade -l String -u 0 -m .f.t_mb.search.m.string
menu .f.t_mb.search.m.string
.f.t_mb.search.m.string add command -l {Forward} -u 0 -acc {} -co {if {[winfo exists .f.t]} {
  th_Misc_search .f.t forward string
} else {
  destroy .f.t_mb}}
.f.t_mb.search.m.string add command -l {Reverse} -u 0 -acc {} -co {if {[winfo exists .f.t]} {
  th_Misc_search .f.t backward string
} else {
  destroy .f.t_mb}}
.f.t_mb.search.m add cascade -l Glob -u 0 -m .f.t_mb.search.m.glob
menu .f.t_mb.search.m.glob
.f.t_mb.search.m.glob add command -l {Forward} -u 0 -acc {} -co {if {[winfo exists .f.t]} {
  th_Misc_search .f.t forward glob
} else {
  destroy .f.t_mb}}
.f.t_mb.search.m.glob add command -l {Reverse} -u 0 -acc {} -co {if {[winfo exists .f.t]} {
  th_Misc_search .f.t backward glob
} else {
  destroy .f.t_mb}}
.f.t_mb.search.m add cascade -l Regexp -u 0 -m .f.t_mb.search.m.regexp
menu .f.t_mb.search.m.regexp
.f.t_mb.search.m.regexp add command -l {Forward} -u 0 -acc {} -co {if {[winfo exists .f.t]} {
  th_Misc_search .f.t forward regexp
} else {
  destroy .f.t_mb}}
.f.t_mb.search.m.regexp add command -l {Reverse} -u 0 -acc {} -co {if {[winfo exists .f.t]} {
  th_Misc_search .f.t backward regexp
} else {
  destroy .f.t_mb}}
.f.t_mb.search.m add checkbutton -variable TH(Search,Case,.f.t)\
  -onvalue 1 -offvalue 0 -l {Case Inensitive} -u 0 -acc {} -co {if {[winfo exists .f.t]} {
  th_checkbutton_variable Search,Case,.f.t
} else {
  destroy .f.t_mb}}
.f.t_mb.search.m add checkbutton -variable TH(Search,Incremental,.f.t)\
  -onvalue 1 -offvalue 0 -l {Incremental Search} -u 0 -acc {} -co {if {[winfo exists .f.t]} {
  th_toggle_incremental_search .f.t
} else {
  destroy .f.t_mb}}

menubutton .f.t_mb.extras -m .f.t_mb.extras.m -text Extras -u 1
pack .f.t_mb.extras -in .f.t_mb -side left
menu .f.t_mb.extras.m
.f.t_mb.extras.m add command -l {Abort} -u 0 -acc {} -co {if {[winfo exists .f.t]} {
  th_beep
} else {
  destroy .f.t_mb}}

# File options
set TH(Pipe,Enabled) 1

menubutton .f.t_mb.file -m .f.t_mb.file.m -text File -u 0
pack .f.t_mb.file -in .f.t_mb -side left
menu .f.t_mb.file.m
.f.t_mb.file.m add command -l {Save} -u 0 -acc {} -co {if {[winfo exists .f.t]} {
  th_save_file .f.t
} else {
  destroy .f.t_mb}}
.f.t_mb.file.m add command -l {Save As} -u 5 -acc {} -co {if {[winfo exists .f.t]} {
  th_save_file_prompt .f.t
} else {
  destroy .f.t_mb}}
.f.t_mb.file.m add checkbutton -variable TH(Pipe)\
  -onvalue 1 -offvalue 0 -l {Use a Pipe} -u 6 -acc {} -co {if {[winfo exists .f.t]} {
  th_checkbutton_variable Pipe
} else {
  destroy .f.t_mb}}
.f.t_mb.extras.m entryconfigure {Abort} -u 0  -acc {} -co {if {[winfo exists .f.t]} {
  th_beep
} else {
  destroy .f.t_mb}}

# Grid options
menubutton .f.t_mb.window -m .f.t_mb.window.m -text Window -u 0
pack .f.t_mb.window -in .f.t_mb -side left
menu .f.t_mb.window.m
.f.t_mb.window.m add checkbutton -variable TH(Grid_X,.f.t)\
  -onvalue 1 -offvalue 0 -l {Horizontal Grid} -u 0 -acc {} -co {if {[winfo exists .f.t]} {
  th_[winfo class .f.t]_toggle_grid_x .f.t -before .f.t -side top -anchor e
} else {
  destroy .f.t_mb}}
.f.t_mb.window.m add checkbutton -variable TH(Grid_Y,.f.t)\
  -onvalue 1 -offvalue 0 -l {Vertical Grid} -u 0 -acc {} -co {if {[winfo exists .f.t]} {
  th_[winfo class .f.t]_toggle_grid_y .f.t 4 -after .f.t -side right -anchor e
} else {
  destroy .f.t_mb}}

# Menubar traversal
tk_menuBar .f.t_mb .f.t_mb.search .f.t_mb.extras .f.t_mb.file .f.t_mb.window

frame .t_fm
set TH(Frame,.f.t) .t_fm
pack .t_fm -in .f.t_mb -fill x -side left -anchor e

}


