#!/afs/ece/usr/tcl/bin/wisha -f

# To run this program, you should make sure the top line reflects the location
# of wish on your system, and the following variable for beth is set properly.

set Elsbeth_Dir "[file dirname [info script]]/../"


# Completion stuff

# This is somehow necessary to keep the first event from being lost.
history add "created"

# Returns with same string, to placate completion.
proc string_identity {s} { return [list $s ""] }

# Returns with the last event (for !!)
proc string_last_event {s} {
  if {[string match "*!!" $s]} {
    return [list [append [string range $s 0 [expr [string length $s] -2]] \
		[history event [expr [history nextid] -1]]]]
  } else {return [list "" ""]
}}

# Replaces s with its history event
proc string_history_event {s} {
  if {$s == ""} {return [list "" ""]}
  if {[catch "history event $s" result]} {
    return [list "" "History search failed because:\n$result"]
  } else {return [list [string trimright $result \n] ""]
}}

# If s is a complete Tcl command or prefix, brings up info on s.
proc filter_info_cmds {s args} {
  global TH Info
  catch_remote_nonresponse "$TH(Completion,Prefix) info procs [list [list $s]]" strings
  if {$s == $strings} {
    catch_remote_nonresponse "$TH(Completion,Prefix) info args $s" args
    set Info "Procedure $s takes arguments: $args"
  }
  return [th_filter_cmds $s]
}


# Like catch, but handles remote interps going down specially.
proc catch_remote_nonresponse {cmd {var ""}} {
  if {$var != ""} {upvar $var result}

  if {[catch $cmd output]} {
    if {($output == "remote interpreter did not respond") ||
      [string match "send to * failed *" $output] ||
      [string match "receiver never heard of *" $output] ||
      [string match "no registered interpreter *" $output]} {
      newApp local
      if {$var != ""} {set result "$output; setting interpreter to local"}
      return 1
    } else {if {$var != ""} {set result $output}
      return 1
  }} else {if {$var != ""} {set result $output}
    return 0
}}


# Keeps the pwd variables up-to-date
proc update_pwd {} {
  global TH
  while {[catch_remote_nonresponse "$TH(Completion,Prefix) pwd" dir]} {}
  set TH(File,.sym1.t) $dir
  th_file_update_widgets .sym1.t
}


# A slightly fancier version than the one in rmt. This one, if the cmd is not
# legit Tk/tcl, passes it to exec. (just like interactive wish)
# Also removes the '!!' option, that's taken care of elsewhere.
# Don't do gradual if:
#  1. User did not request it
#  2. Executing in a remote interpreter
proc invoke {w} {
    global App Info
    th_Text_complete_multiple $w {
	{th_substring_replace string_last_event none}
	{th_substring_replace string_history_event {!}}
	{th_substring_replace string_identity none}}
    set shown_cmd [$w get Output.last+1c end]
    th_Text_complete_multiple $w {
	{th_substring_replace th_string_glob_files { }}
	{th_substring_replace string_identity none}}
    set cmd [string trim [$w get Output.last+1c end] " \n\t"]
    $w delete Output.last+1c end
    set ol [$w index end]
    $w insert end "$shown_cmd\n"
    $w mark set insert end
    $w tag add Command $ol end-1c
    $w tag remove Command end-1c end
    $w tag remove Output $ol end

# These routines should try and interpret cmd as best they can. See the
# execute_wish_cmd procedure for format on what values should be set.
# (the output of execute_wish_cmd goes into: result cmd msg Info)
    set result 0 ; set msg "" ; set Info ""
    .sym1.t_fm.info configure -textvariable Info

    if {[info complete $cmd]} {
  global TH
  $w configure -cursor watch ; update

# Empty line ?
# Considered a successful no-op command
  if {[string length $cmd] == 0} {
    set result 2

# Gradual requested, but in remote interpreter, so no can do. ?
# Indicate command should not be completed.
  } elseif {[string match *\@ $cmd] && [string match "send*" $TH(Completion,Prefix)]} {
    set Info "Can only do graduated reading in local interpreter"

# Remote interpreter failed to respond ?
# Indicate command should not be completed
  } elseif {[catch_remote_nonresponse "$TH(Completion,Prefix) info \
          commands [lindex $cmd 0]" output]} {
    set Info $output

# Wish command ?
  } elseif {[llength $output] == 1} {
    set output [execute_wish_cmd $w]
    set result [lindex $output 0] ; set msg [lindex $output 2]
    set cmd [lindex $output 1] ; set Info [lindex $output 3]

# Gradual exec command ?
  } elseif {($TH(Gradual) || [string match *\@ $cmd]) &&
![string match *\& $cmd] && ![string match "send*" $TH(Completion,Prefix)]} {
    set new_cmd "| [string trimright $cmd \@] |& cat &"
    set oldfile $TH(File,$w)
    set TH(File,$w) "[pwd]/$new_cmd"
    set result [catch "th_load_file $w 1"]
    .sym1.t tag add Output Command.last+1c end-1c
    th_Text_goto $w end 0
    set TH(File,$w) $oldfile
    if {!$result} {set result 2}
    if {$msg == "child process exited abnormally"} {
      set Info $msg
      set msg ""}

# Exec command ?
  } else {if {[string match *\& $cmd]} {  set new_cmd $cmd
    } else {set new_cmd "$cmd |& cat"}
    set result [catch_remote_nonresponse \
        "$TH(Completion,Prefix) exec [list $new_cmd]" msg]
    if {!$result} {set result 2}}

  $w configure -cursor xterm

  switch $result 0 {
    # Command was incomplete, re-use it.
    $w delete Output.last+1c end
    $w insert end $cmd

    } 1 {
    # Command generated error, do same as if successful.
    if {$msg != ""} {
      $w insert end "$msg\n"
      $w tag add Output Command.last+1c end-1c}
    update_pwd
    prompt $w

    } 2 {
    # Command was successful, add to history, issue prompt.
    set cl [$w index Command.last]
    if {$msg != ""} {
      $w insert end "$msg\n"
      $w tag add Output Command.last+1c end-1c
    } else {
      $w insert end-1c " "
      $w tag add Output Command.last end-2c}
    $w tag remove Command $cl end
    history change $shown_cmd
    history add $shown_cmd
    update_pwd
    prompt $w
    }}
    $w yview -pickplace insert
}

# execute_wish_cmd should return 4 items in a list. The first one is:
# 0 if cmd didn't get executed (ie was incomplete)
# 1 if cmd got executed & yielded an error
# 2 if cmd executed normally
# The second one is the cmd as it was executed, or completed.
# The third item is the output (either of a successful or failed cmd) to be
# placed in the text widget.
# The fourth item is Info to put on the top (outside the text widget.)
proc execute_wish_cmd {w} {
  global TH
  set cmd [string trim [$w get Output.last end] " \n\t"]
  set result [catch_remote_nonresponse "$TH(Completion,Prefix) [list $cmd]" msg]

# Wish cmd was successful
  if {!$result} {    return [list 2 $cmd $msg ""]}

# Handle incorrect-number-of-argument and unknown-option type errors.
  if {[string match {wrong # args: *} $msg] ||
      [string match {unknown option *} $msg]} {
    return [list 0 $cmd "" $msg]}

  set list [parse_error $msg]
# Cmd generated an error we can't handle
  if {$list == ""} {  return [list 1 $cmd $msg ""]}

# Handle here-are-the-possible-choices type errors.
  set selection [th_dialog_listbox .option {Option Dialog} [lindex $list 0] \
	[lrange $list 2 end]]
# User didn't request correction.
  if {$selection == ""} {  return [list 0 $cmd "" ""]}

  regsub [lindex $list 1] $cmd $selection new_cmd
# User requested correction.
  return [list 0 $new_cmd "" ""]
}

# We are trying to parse up error messages like:
# bad tag option "foo":  must be add, bind, configure, delete, lower, names, 
# nextrange, raise, ranges, or remove
# Returns list where first item is everything up to "must be", 
# second item is the bad option (foo in this case),
# and remaining itmes are the legitimate options.
proc parse_error {msg} {
  if {![string match "* must be *, or *" $msg] &&
    ![string match {* should be *, or *} $msg]} {  return ""}

  set list [split $msg]
  set index 0
  while 1 {
    set index [lsearch [lrange $list $index end] "be"]
    incr index -1
    if {([lindex $list $index] == "should") || ([lindex $list $index] == "must")} {break}
    incr index +2
  }
  incr index
  set result [list "[join [lrange $list 0 $index]]:"]

  set bad_option_index [lsearch $list {"*":}]
  set result [lappend result [string trim [lindex $list $bad_option_index] \
    {":;}]]

  incr index
  foreach element [lrange $list $index end] {
    if {$element != "or"} {  lappend result [string trimright $element ","]}}

  return $result
}

# The procedure below is used to print out a prompt at the
# insertion point (which should be at the beginning of a line
# right now).
proc prompt {w} {
  .sym1.tgridy configure -state normal
  scan [.sym1.tgridy index end] "%d.%d" y dummy
  scan [.sym1.t index end] "%d.%d" endy dummy
  for {} {$y < $endy} {incr y} {.sym1.tgridy insert end "\n"}
  .sym1.tgridy insert end ">"
  .sym1.tgridy configure -state disabled
  .sym1.t tag add Command end-1c
}

proc clear_to_insert {} {
  scan [.sym1.t index insert] "%d.%d" y dummy
  .sym1.t delete 2.0 "$y.0"
  .sym1.tgridy configure -state normal
  .sym1.tgridy delete 2.0 "$y.0"
  .sym1.tgridy configure -state disabled
}

# The following procedure is invoked to change the Application that
# we're talking to.  It also updates the prompt for the current
# command, unless we're in the middle of executing a command from
# the text item (in which case a new prompt is about to be output
# so there's no need to change the old one).
proc newApp {AppName} {
  global App TH
  set App $AppName
  if {$App == "local"} {set TH(Completion,Prefix) "uplevel #0"
  } else {set TH(Completion,Prefix) [list send $App]}
  update_pwd
  return {}
}

# The procedure below will fill in the Applications sub-menu with a list
# of all the Applications that currently exist.
proc fillappsMenu {m} {
  catch {$m delete 0 last}
  foreach i [lsort [winfo interps]] {
    $m add command -label $i -command [list newApp $i]
  }
  $m add command -label local -command {newApp local}
}


# Searches ranges for index. More efficient than list search, since ranges
# is ordered.
proc text_list_bisearch {w index ranges} {
  set l [llength $ranges]
  if {[$w compare $index == [lindex $ranges 0]]} {return 0}
  if {[$w compare $index == [lindex $ranges [expr $l - 1]]]} {return [expr $l - 1]}

  set l [expr $l / 2]
  set i $l
  set r [lindex $ranges $i]
  while {[$w compare $index != $r]} {
    if {$l != 1} {set l [expr $l / 2]}
    if {[$w compare $index < $r]} {  incr i -$l
    } else {      incr i $l}
    set r [lindex $ranges $i]
  }
  return $i
}

# Line $w tag nextrange, but returns the range whose start is previous to index
proc tag_prevrange {w tag index} {
  set ranges [$w tag ranges $tag]
  set nextrange [$w tag nextrange $tag "$index +1c"]
  if {$nextrange == ""} {
    set i [llength $ranges]
  } else {set i [text_list_bisearch $w [lindex $nextrange 0] $ranges]}
  return [lrange $ranges [expr $i - 2] [expr $i - 1]]
}

proc cmd_begin {w index} {
  if {[set begin [lindex [tag_prevrange $w Command $index] 0]] == ""} {return ""
  } else {return "$begin +1c"}
}

proc cmd_end {w index} {
 return [lindex [tag_prevrange $w Command $index] 1]
}

proc cmd_next {w index} {
  if {[set begin [lindex [$w tag nextrange Command $index] 0]] == ""} {return ""
  } else {return "$begin +1c"}
}

proc cmd_prev {w index} {
  if {[$w compare [set begin [cmd_begin $w $index]] != $index]} {
    return $begin 
  } else {return [cmd_begin $w "$index -2c"]
}}

proc cmd_select {w} {
  set s [cmd_begin $w insert] ; set e [cmd_end $w insert]
  if {($s == "") || ($e == "")} {th_beep ; return}
  th_Text_select_range $w $s $e
}

proc rmth_help {} {
  global Elsbeth_Dir
  exec $Elsbeth_Dir/bin/elsbeth $Elsbeth_Dir/aux/rmth.HELP.txt &
}

set argv "$argv -a 0"
incr argc 2
source $Elsbeth_Dir/bin/elsbeth
set App_Name Rmth
els_source_local_files rmth

# Change window title/icon to hostname
wm title .sym1 "Rmth: $env(HOST)"
wm iconname .sym1 "R [lindex [split $env(HOST) .] 0]"

set App "local"
# Add an info label, usually empty.
set Info ""
label .sym1.t_fm.info -relief raised -textvariable Info
pack forget .sym1.t_fm.q
pack forget .sym1.t_fm.fmb
pack .sym1.t_fm.info -in .sym1.t_fm -side right
pack .sym1.t_fm.quit -side right -expand yes -fill x

# Add two labels on the frame to display the pwd.
set TH(File,.sym1.t) [pwd]

focus default .sym1.t ; focus .sym1.t
label .sym1.t_mb.mb_app -textvariable App
pack .sym1.t_mb.mb_app -side right

th_Text_toggle_grid_y .sym1.t 1 -side right -after .sym1.t
.sym1.t insert 1.0 "Rmth 2.0 -- by David Svoboda\n"
.sym1.t tag add Output 1.0 "1.0 lineend"
.sym1.tgridy configure -state normal ; .sym1.tgridy delete 1.0 end ; 
prompt .sym1.t
newApp local
update_pwd


# Elsbeth-determined bindings
th_bind Text OK "invoke %W"
.sym1.t_mb.mb_index.m add cascade -label Application -underline 1 \
      -command {fillappsMenu .sym1.t_mb.mb_index.m.application} \
	-menu .sym1.t_mb.mb_index.m.application
menu .sym1.t_mb.mb_index.m.application
# We want two sets of completions, one interactive, one for command invocation
set Rmth_Completions {
	{th_substring_replace string_last_event none}
	{th_substring_replace string_history_event {!}}
 	{th_line_complete filter_info_cmds none}
	{th_substring_replace th_string_tcl_result {[}}
	{th_substring_replace th_string_global_value {$}}
	{th_substring_replace th_string_glob_files { }}
	{th_substring_complete filter_info_cmds {[}}
	{th_substring_complete th_filter_vars {$}}
	{th_substring_complete th_filter_glob { }}
}
th_bind Text Complete_Word {if {![th_Text_complete_multiple %W $Rmth_Completions]} {catch {th_Text_self_insert %W %A}}}
.sym1.t_mb.mb_extras.m entryconfigure Complete -command {th_Text_complete_multiple %W $Rmth_Completions}

# These bindings may need to be changed if you change the elsbeth bindings.
foreach b {<Control-h> <Delete>} {
  bind Text $b {if {[%W compare [cmd_begin %W insert] == insert]} {th_beep} else {th_Text_delete_range %W {insert -1c} insert 0}}
}
.sym1.t_mb.mb_edit.m.delete.character entryconfigure Previous -command {if {[.sym1.t compare [cmd_begin .sym1.t insert] == insert]} {th_beep} else {th_Text_delete_range .sym1.t {insert -1c} insert 0}}

.sym1.t_mb.mb_file.m add checkbutton -label "Gradual I/O" -variable TH(Gradual)
set TH(Gradual) 1
bind Text <Meta-q> {els_destroy_text .sym1.t}
.sym1.t_fm.quit configure -command {els_destroy_text .sym1.t}
.sym1.t_mb.mb_file.m add command -label "Quit" -accel "<Meta-q>" -command {els_destroy_text .sym1.t}
bind Text <Control-u> {clear_to_insert}
.sym1.t_mb.mb_edit.m add command -l {Clear} -u 0 -acc {<Control-u>} -co {clear_to_insert}
.sym1.t_mb.mb_window.m delete {Vertical Grid}
bind Text <Meta-Control-h> {rmth_help}
.sym1.t_mb.mb_command.m.commands add command -label Help -c {rmth_help} -accel <Meta-Control-h>
bind Text <Control-A> {th_Text_goto %W [cmd_begin %W insert]}
bind Text <Control-E> {th_Text_goto %W [cmd_end %W insert]}
bind Text <Control-N> {th_Text_goto %W [cmd_next %W insert]}
bind Text <Control-P> {th_Text_goto %W [cmd_prev %W insert]}
bind Text <Control-J> {cmd_select %W}
bind Text <Control-H> {th_Text_delete_range %W [cmd_begin %W insert] insert}
bind Text <Control-D> {th_Text_delete_range %W insert [cmd_end %W insert]}
bind Text <Control-U> {th_Text_kill_range %W [cmd_begin %W insert] [cmd_end %W insert]}
.sym1.t_mb.mb_browse.m.goto add cascade -l Command -u 0 -m .sym1.t_mb.mb_browse.m.goto.command
menu .sym1.t_mb.mb_browse.m.goto.command
.sym1.t_mb.mb_browse.m.goto.command add command -l {Begin} -u 0 -acc {<Control-A>} -co {th_Text_goto .sym1.t [cmd_begin .sym1.t insert]}
.sym1.t_mb.mb_browse.m.goto.command add command -l {End} -u 0 -acc {<Control-E>} -co {th_Text_goto .sym1.t [cmd_end .sym1.t insert]}
.sym1.t_mb.mb_browse.m.goto.command add command -l {Next} -u 0 -acc {<Control-N>} -co {th_Text_goto .sym1.t [cmd_next .sym1.t insert]}
.sym1.t_mb.mb_browse.m.goto.command add command -l {Previous} -u 0 -acc {<Control-P>} -co {th_Text_goto .sym1.t [cmd_prev .sym1.t insert]}
.sym1.t_mb.mb_browse.m.select add command -l {Command} -u 0 -acc {<Control-J>} -co {cmd_select .sym1.t}
.sym1.t_mb.mb_edit.m.delete add cascade -l Command -u 1 -m .sym1.t_mb.mb_edit.m.delete.command
menu .sym1.t_mb.mb_edit.m.delete.command
.sym1.t_mb.mb_edit.m.delete.command add command -l {Previous} -u 0 -acc {<Control-H>} -co {th_Text_delete_range .sym1.t [cmd_begin .sym1.t insert] insert}
.sym1.t_mb.mb_edit.m.delete.command add command -l {Next} -u 0 -acc {<Control-D>} -co {th_Text_delete_range .sym1.t insert [cmd_end .sym1.t insert]}
.sym1.t_mb.mb_edit.m.kill add command -l {Command} -u 1 -acc {<Control-U>} -co {th_Text_kill_range .sym1.t [cmd_begin .sym1.t insert] [cmd_end .sym1.t insert]}


