#!/afs/ece/usr/tcl/bin/wish -f
# The next line is executed by most shells, but not Tcl \
wish $0 $*


# 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 "can't send to old *" $output] ||
      [string match "no application named *" $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 env
  while {[catch_remote_nonresponse "$TH(Completion,Prefix) pwd" dir]} {}
  set TH(File,New,.syme1.t) $dir
  set TH(File,.syme1.t) $dir
  th_file_update_widgets .syme1.t
# Change window title/icon to hostname
  wm title .syme1 "Rmth: $env(HOST)"
  wm iconname .syme1 "R [lindex [split $env(HOST) .] 0]"
}


# 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 end-1c]
  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 end-1c] " \n\t"]
  $w delete Output.last end
  $w insert end "\n" Output
  $w insert end $shown_cmd

# 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 ""
  .syme1.t_fm.info configure -textvariable Info

# Is command incomplete (i.e. has unmatched braces or brackets?)
  if {![info complete $cmd]} {
    $w insert insert "\n"
    $w see insert
    return
  }

  $w insert end "\n" Output
  $w tag add Output end-2c end
  $w configure -cursor watch ; update
  global TH

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

# 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

# Exec command?
  } elseif {([llength $output] != 1) && [auto_execok [lindex $cmd 0]]} {
# Background exec command?
    if {[string match *\& $cmd]} {
      set result [catch_remote_nonresponse \
          "$TH(Completion,Prefix) exec [list $cmd]" msg]
      if {!$result} {set result 2}
    } else {
      set new_cmd "| $cmd |& cat"
      set TH(File,New,$w) "[pwd]/$new_cmd"
      $w mark set insert end-1c
      set result [catch "th_load_file $w 1"]
      th_Text_goto $w end-1c 0
      if {!$result} {set result 2} else {
        global errorInfo
        set e [string first "\n" $errorInfo] ; incr e -1
        set msg [string range $errorInfo 0 $e]
      }
      if {$msg == "child process exited abnormally"} {
        set Info $msg
        set msg ""
# Wish command ?
  }}} else {
    set output [execute_wish_cmd $w $cmd]
    set result [lindex $output 0] ; set msg [lindex $output 2]
    set cmd [lindex $output 1] ; set Info [lindex $output 3]
  }

  $w configure -cursor xterm

  switch $result 0 {
    # Command was incomplete, re-use it.
    $w delete end-2c end
    $w delete Output.last end
    $w insert end "\n" Output
    $w insert end $cmd

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

    } 2 {
    # Command was successful, add to history, issue prompt.
    if {$msg != ""} {
      $w insert end-1c "$msg\n" Output}
    history change $shown_cmd
    history add $shown_cmd
    update_pwd
    prompt $w
  }
  $w see 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 cmd} {
  global TH
  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 # arg*} $msg] ||
	[string match {no value given *} $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, ...
# 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} {
  .syme1.t_gridy configure -state normal
  scan [.syme1.t_gridy index end] "%d.%d" y dummy
  scan [.syme1.t index end] "%d.%d" endy dummy
  for {} {$y > $endy} {incr y -1} {.syme1.t_gridy delete end-1c}
  for {} {$y < $endy} {incr y} {.syme1.t_gridy insert end "\n"}
  .syme1.t_gridy insert end ">\n\n\n"
  .syme1.t_gridy configure -state disabled
  $w tag remove Output end-1c
}

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


proc cmd_begin {w index} {
  set i [$w index "$index linestart"]
  return [.syme1.t_gridy search -backwards -- ">" "$i+1c" 1.0]
}

proc cmd_end {w index} {
  if {[set b [cmd_begin $w $index]] == ""} {return ""}
  if {[set i [lindex [$w tag nextrange Output $b] 0]] == ""} {return end-1c
  } else {return $i}
}

proc cmd_next {w index} {
  set i [$w index "$index +1l linestart"]
  return [.syme1.t_gridy search -forwards -- ">" "$i-1c" end]
}

proc cmd_prev {w index} {
  set i [$w index "$index -1l linestart"]
  return [.syme1.t_gridy search -backwards -- ">" "$i+1c" 1.0]
}

proc rmth_clear {w} {
  set i [$w index "insert linestart"]
  if {[$w compare Output.last <= $i]} {set i [$w index "Output.last -1 lines"]}
  .syme1.t_gridy configure -state normal
  .syme1.t_gridy delete 1.0 $i
  .syme1.t_gridy configure -state disabled
  $w delete 1.0 $i
}

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


# First, source els (which handles command-line arguments)
set argv "$argv -a 0"
incr argc 2
source $Elsbeth_Dir/bin/els

# Now get TH bindings & menus
source $Elsbeth_Dir/lib/tk.tcl
th_Text_menus .syme1.t

# We want pipes to be readable in rmth
set TH(Pipe,Enabled) 1

# Two checkbuttons, like elsbeth, but these display the pwd.
pack [checkbutton .syme1.t_fm.fpl -textvariable TH(File,fpl,.syme1.t) -indicatoron 0 -variable TH(File,fpl,.syme1.t) -anchor e -onvalue {} -offvalue {-}] -side left
set TH(File,fpl,.syme1.t) {}
pack [checkbutton .syme1.t_fm.fnl -textvariable TH(File,fnl,.syme1.t) -indicatoron 0 -variable TH(File,fnl,.syme1.t) -anchor e -onvalue {} -offvalue {-}] -side left
set TH(File,fnl,.syme1.t) {}
.syme1.t_fm.fpl invoke
set TH(File,.syme1.t) [pwd]

# Now source the user's rmth file
th_source_local_files

# Add an info label, usually empty.
set Info ""
label .syme1.t_fm.info -relief raised -textvariable Info
pack .syme1.t_fm.info -in .syme1.t_fm -side right

# Add a quit button.
pack [button .syme1.t_fm.quit -text Quit -command exit] -side right -expand yes -fill x
bind Text <Meta-q> exit

focus .syme1.t

# Add vertical & horizontal scrollbars, and the vertical grid.
th_toggle_scrollbar .syme1.t x bottom
th_toggle_scrollbar .syme1.t y left
th_Text_toggle_grid_y .syme1.t left
.syme1.t_gridy configure -state normal ; .syme1.t_gridy delete 1.0 end ; 
bind Text <Meta-y> {bell}

# make an option menu for app
tk_optionMenu .syme1.t_mb.apps App local
pack .syme1.t_mb.apps -side right
bind .syme1.t_mb.apps <Button-1> {if {$tkPriv(inMenubutton) != ""} {
            fillappsMenu .syme1.t_mb.apps.menu
	    tkMbPost $tkPriv(inMenubutton) %X %Y}}
bind Text <Button-3> {fillappsMenu .syme1.t_mb.apps.menu ; update ;  tk_popup .syme1.t_mb.apps.menu %X %Y [.syme1.t_mb.apps.menu index $App] ; focus .syme1.t ; break}

# Fill rmth text & init procedures
.syme1.t insert 1.0 "Rmth 2.1 -- by David Svoboda\n"
.syme1.t tag add Output 1.0 2.0
prompt .syme1.t
set App "local"
newApp local
update_pwd


# Some Elsbeth-type bindings & menubuttons
foreach binding {<Return> <Control-m> <KP_Enter>} {
  bind Text $binding "invoke %W"
}

# We want two sets of completions, one interactive, one for command invocation
lappend TH(Completions,Text) \
	{th_substring_replace string_last_event none} \
	{th_substring_replace string_history_event {!}} \
 	{th_line_complete filter_info_cmds none}

foreach b {<Control-h> <BackSpace>} {
  bind Text $b {if {[%W compare [cmd_begin %W insert] == insert]} {bell} else {th_Text_delete_range %W {insert -1c} insert 0}}
}
.syme1.t_mb.mb_edit.m.delete.character entryconfigure Previous -command {if {[.syme1.t compare [cmd_begin .syme1.t insert] == insert]} {bell} else {th_Text_delete_range .syme1.t {insert -1c} insert 0}}

.syme1.t_mb.mb_file.m add command -label "Quit" -u 0 -accel "<Meta-q>" -command {exit}
.syme1.t_mb.mb_window.m delete {Vertical Grid}
bind Text <Meta-Control-h> {rmth_help}
.syme1.t_mb.mb_command.m.commands add command -label Help -u 0 -c {rmth_help} -accel <Meta-Control-h>
bind Text <Meta-a> {th_Text_goto %W [cmd_begin %W insert]}
bind Text <Meta-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> {th_Text_select_group %W cmd_begin cmd_end Command}
bind Text <Control-u> {th_Text_kill_range %W [cmd_begin %W insert] [cmd_end %W insert]}
.syme1.t_mb.mb_browse.m.goto add cascade -l Command -u 1 -m .syme1.t_mb.mb_browse.m.goto.command
menu .syme1.t_mb.mb_browse.m.goto.command
.syme1.t_mb.mb_browse.m.goto.command add command -l {Begin} -u 0 -acc {<Meta-a>} -co {th_Text_goto .syme1.t [cmd_begin .syme1.t insert]}
.syme1.t_mb.mb_browse.m.goto.command add command -l {End} -u 0 -acc {<Meta-e>} -co {th_Text_goto .syme1.t [cmd_end .syme1.t insert]}
.syme1.t_mb.mb_browse.m.goto.command add command -l {Next} -u 0 -acc {<Control-N>} -co {th_Text_goto .syme1.t [cmd_next .syme1.t insert]}
.syme1.t_mb.mb_browse.m.goto.command add command -l {Previous} -u 0 -acc {<Control-P>} -co {th_Text_goto .syme1.t [cmd_prev .syme1.t insert]}
.syme1.t_mb.mb_browse.m.select add command -l {Command} -u 1 -acc {<Control-j>} -co {th_Text_select_group .syme1.t cmd_begin cmd_end command}
.syme1.t_mb.mb_edit.m.cut add command -l {Command} -u 1 -acc {<Control-u>} -co {th_Text_kill_range .syme1.t [cmd_begin .syme1.t insert] [cmd_end .syme1.t insert]}
.syme1.t_mb.mb_extras.m add command -l {Execute} -u 0 -acc {<Return>} -co {invoke .syme1.t}

bind Text <Meta-L> {rmth_clear %W}
.syme1.t_mb.mb_edit.m.delete add command -l {Clear to line} -u 9 -acc {<Meta-L>} -co {rmth_clear .syme1.t}

# Flash a help label
th_flash_label .syme1.t -relief ridge -text "Press <Meta-Control-h> for help."
