#!/ndc/bin/wish
#
# xtel - A remote window connection manager.
#        Spawns a new window and to connects to the host.
#
set version "3.03"
#
# Craig Smith (chs@cs.uoregon.edu)
# Gensis date: 2-7-95
#
# Modification History
#   2-7-95   Craig Smith <chs@cs.uoregonn.edu>
#       1.0 -  original version
#   2-27-95  major hacks by Bernd Mohr:
#       2.0 -  Ctrl-q quits program
#       2.0 - read / write .xtelrc
#       2.0 - host / function menu through button-2
#       2.0 - hostname completion with TAB
#       2.0 - added telnet/rlogin buttons + Ctrl-R/Ctrl-T shortcut
#       2.0 - iconname also set for window
#       2.0 - preferences
#  4-15-1995 paul e. bloch <paul@cs.uoregon.edu>
#       2.1 - added a socks telnet button
#  5-4-1995  paul e. bloch
#       2.11 - added -ls to xterm in local window, so it is login shell.
#  5-23-1995 paul e. bloch
#       2.12 - moved pull down menu to right button to make way for paste
#               with middle button.
#  5-24-1995 jeff hobbs <jhobbs@cs.uoregon.edu>
#       2.13 - added paste selection to middle button
#       2.13 - added reset entry to the "cancel" menu item
#  5-24-1995 jeff hobbs
#       2.14 - added Ctrl-c command to clear entry widget
#       2.14 - made version align to the right
#       2.14 - added recognition of KeyPad_Enter for entry widget
#       2.14 - added listbox for pruning history, spawning on a
#               double-click, (dis)appear with Ctrl-p
#  6-27-1995 jeff hobbs
#       2.15 - added support to change geometry in .xtelrc
#  6-27-1995 jeff hobbs
#       3.00 - updated to use tk4
#       3.00 - changed checkbutton creation, management
#       3.00 - added option of unique id for window titles
#  6-29-1995 paul e. bloch
#       3.01 - fixed local xterm windows to use the unique id
#  7-17-1995 jeff hobbs
#       3.02 - made '_' the separator for name & id to offset winterm bug
#       3.02 - "beep" should have been "bell", now fixed
#  10-4-1995 jeff hobbs
#       3.03 - added {local,remote}opts and OS differences
#

#
# preferences (can be overridden in ~/.xtelrc)
#
catch "exec /sbin/uname -s" os
if [string match {IRIX*} $os] {
  set xtel(wincmd)      "winterm";      # default command to bring up window
  set xtel(localopts)   "";             # opts used when launching local win
  set xtel(remoteopts)  "";             # opts used when launching remote win
} else {
  set xtel(wincmd)      "xterm";        # default command to bring up window
  set xtel(localopts)   " -ls";         # opts used when launching local win
  set xtel(remoteopts)  "";             # opts used when launching remote win
}
set xtel(geometry)      "+725+0";       # geometry can be overriden
set xtel(button)        "{telnet telnet t} {rlogin rlogin r}\
    {socks /local/apps/socks/bin/telnet s}"; # button defaults
set xtel(default)       "telnet";       # default command
set xtel(history)       "";             # history of used hosts
set xtel(id)            0;

proc clear_and_spawn { to } {
  global xtel

  if {$to == ""} { set name $xtel(host) } else { set name $to }
  if {$xtel(id) >= 0} {
      set xtel(id) [expr ($xtel(id)+1) % 100]
      set name "${name}_$xtel(id)"
  }

  if {$to == ""} {
    # -- local window
    eval exec $xtel(wincmd) $xtel(localopts) -n "$name" -T "$name" &
  } else {
    # -- remote window
    set cmd $xtel(default)
    eval exec $xtel(wincmd) $xtel(remoteopts) \
        -n "$name" -T "$name" -e $cmd $to &

    # -- add host to history if not yet there
    if { [lsearch -exact $xtel(history) $to] == -1 } {
      lappend xtel(history) $to
      set xtel(history) [lsort $xtel(history)]
    }
  }
  # -- reset entry
  .xtel.e delete 0 end

}

proc read_rc_file {} {
  global xtel env

  # -- read .xtelrc if it exists
  if [ file readable $env(HOME)/.xtelrc ] {
    set in [open $env(HOME)/.xtelrc "r"]
    # Cache buttons default
    set tmp $xtel(button); set xtel(button) {};
    while { [gets $in line] >= 0 } {
      # -- ignore empty and comment lines
      if { $line != "" && [regexp {^#} $line] == 0 } {
        if [regexp {(.*)=(.*)}  $line dummy field value] {
          # -- line contains "="
          if {$field == "button"} {
            lappend xtel(button) "$value"
          } elseif [info exists xtel($field) ] {
            set xtel($field) $value
          }
        } else {
          # -- add to host history
          lappend xtel(history) $line
        }
      }
      set line ""
    }
    catch "close $in"
    if {$xtel(button) == ""} { set xtel(button) $tmp }
  } else {
    set xtel(history) {}
  }
}

proc write_rc_file {} {
  global xtel env

  set out [open $env(HOME)/.xtelrc "w"]
  puts $out "# command to bring up window"
  puts $out "wincmd=$xtel(wincmd)"
  puts $out "# command to bring up window"
  puts $out "localopts=$xtel(localopts)"
  puts $out "# command to bring up window"
  puts $out "remoteopts=$xtel(remoteopts)"
  puts $out "# geometry for xtel window"
  puts $out "geometry=$xtel(geometry)"
  puts $out "# button=name command control-key (optional)"
  foreach b $xtel(button) { puts $out "button=$b" }
  puts $out "# default command"
  puts $out "default=$xtel(default)"
  puts $out "# unique id for windows (not used if == -1)"
  puts $out "id=$xtel(id)"
  puts $out ""
  puts $out "# host history"
  foreach host $xtel(history) {
    puts $out $host
  }
  catch "close $out"
}

proc update_lbox {name element op} {
  global xtel

  set idx [.xtel.btm.t.lbox nearest 0]
  .xtel.btm.t.lbox delete 0 end
  foreach host $xtel(history) { .xtel.btm.t.lbox insert end $host }
  .xtel.btm.t.lbox yview $idx
}

proc prune_setup { {se ""} } {
  global xtel

  if ![winfo exists .xtel.btm] {
    frame .xtel.btm -bd 2 -relief raised
    pack [frame .xtel.btm.t] -fill both
    listbox .xtel.btm.t.lbox -bd 2 -relief sunken \
        -yscrollcommand ".xtel.btm.t.vs set" -selectmode extended
    scrollbar .xtel.btm.t.vs -orient vertical \
        -command ".xtel.btm.t.lbox yview"
    pack .xtel.btm.t.lbox -side left -fill both -expand 1
    pack .xtel.btm.t.vs -side right -fill y
    pack [frame .xtel.btm.b] -side bottom -fill x
    button .xtel.btm.b.prune -text "Prune" -com {
      global xtel
      
      if {[set seld [lsort -int -dec [.xtel.btm.t.lbox cursel]]] != ""} {
        set temp $xtel(history)
        foreach i $seld { set temp [lreplace $temp $i $i] }
        set xtel(history) $temp
      }
    } -padx 2 -pady 2 -highlightt 1
    button .xtel.btm.b.spawn -text "Spawn" -com {
      foreach idx [.xtel.btm.t.lbox curselection] {
        clear_and_spawn [.xtel.btm.t.lbox get $idx]
      }
    } -padx 2 -pady 2 -highlightt 1 -takefocus 0
    button .xtel.btm.b.shrink -text "Shrink" -com "prune_setup shrink" \
        -padx 2 -pady 2 -highlightt 1 -takefocus 0
    pack .xtel.btm.b.prune .xtel.btm.b.spawn .xtel.btm.b.shrink \
        -side left -fill x -expand 1
    bind .xtel.btm.t.lbox <Double-Button-1> {
      clear_and_spawn [.xtel.btm.t.lbox get \
          [.xtel.btm.t.lbox nearest %y]]
    }
  }

  if {$se == ""} { if ![winfo ismapped .xtel.btm] { set se expand } }

  if {$se == "expand"} {
    pack .xtel.btm -fill both
    .xtel.btm.t.lbox delete 0 end
    foreach host $xtel(history) { .xtel.btm.t.lbox insert end $host }
    trace variable xtel(history) w update_lbox
  } else {
    trace vdelete xtel(history) w update_lbox
    pack forget .xtel.btm
  }
}

proc setup_host_menu {} {
  global xtel

  .xtel.m delete 0 last
  .xtel.m add command -label "local" -command { clear_and_spawn "" }
  .xtel.m add command -label "cancel" \
      -command ".xtel.m unpost;.xtel.e delete 0 end"
  .xtel.m add separator
  foreach host $xtel(history) {
    .xtel.m add command -label $host \
        -command "clear_and_spawn $host; .xtel.m unpost"
  }
  .xtel.m add separator
  .xtel.m add command -label "prune" \
      -command "prune_setup expand; .xtel.m unpost"
  .xtel.m add command -label "quit" -command exit
}

proc complete_host {} {
  global xtel

  set found 0
  foreach host $xtel(history) {
    if [regexp "^$xtel(to)" $host] {
      incr found
      set hh $host
    }
  }
  if { $found == 1 } { set xtel(to) $hh } else { bell }
}

proc initialize {} {
  global xtel env

  if [info exists env(HOST)] {
    set xtel(host) $env(HOST)
  } else {
    set xtel(host) [exec hostname]
  }
  read_rc_file
}

# Create a new window with a specific geometry.  This way the
# window can start up at a specific position without having to place it with
# the mouse.

wm withdraw .   
toplevel .xtel
wm title .xtel xtel

initialize

wm geometry .xtel $xtel(geometry)

frame .xtel.top

foreach b $xtel(button) {
  set name [lindex $b 0]; set cmd [lindex $b 1]; set key [lindex $b 2];
  radiobutton .xtel.top.$name -text $name -var xtel(default) \
      -value $cmd -relief flat -padx 0 -pady 0 -highlightt 0
  pack .xtel.top.$name -side left
  if {$key != "" && [string length $key] == 1} {
    bind all <Control-$key> "set xtel(default) $cmd"
    bind Entry <Control-$key> "set xtel(default) $cmd"
  }
}

frame .xtel.middle
label .xtel.l -text "to: "
label .xtel.v -text "v$version" -font *-*-*-*-*-*-*-80-*-*-*-*-*-* -anchor e
entry .xtel.e -width 15 -relief sunken -textvariable xtel(to)
pack  .xtel.l -side left -in .xtel.middle
pack  .xtel.e -side left -in .xtel.middle -fill x -expand 1
pack  .xtel.v -side right -anchor e -in .xtel.middle -fill x
pack  .xtel.top .xtel.middle -side top -anchor w -fill x

menu .xtel.m -postcommand setup_host_menu

bind  all     <Control-q> exit
bind  all     <Control-p> prune_setup
bind  all     <Button-3>  { .xtel.m post %X %Y }
bind  .xtel.e <Control-c> { %W delete 0 end }
bind  .xtel.e <KeyPress-Tab>      { complete_host; break }
bind  .xtel.e <KeyPress-Return>   { clear_and_spawn $xtel(to) }
bind  .xtel.e <KeyPress-KP_Enter> { clear_and_spawn $xtel(to) }
focus .xtel.e

bind . <Destroy> write_rc_file