#!/usr/local/bin/expectk

#  Copyright (c) 1995 by Yatish Patel (pately@vivanet.com)
#  All Rights Reserved.
#
# tkTelnet is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# tkTelnet is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with tkTelnet; see the file COPYING.
# If not, write to the Free Software Foundation,
# 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#
# tkTelnet
set version "1.0a"
set the_unlockpass ""
set button_list {Ernie}
set values(.select.1) {Ernie ernie yatish none login:}
set number_button 2
set userhome $env(HOME)
set locked 0
set program_path ""
set full_path $env(PATH)

proc unlock {} {
    global values number_button userhome version save_on_exit locked
    catch {destroy .select}
    catch {destroy .menu}
    frame .menu -relief raised -bd 2
    frame .select -width 3i
    menubutton .menu.options -text Options -menu .menu.options.menu
    menubutton .menu.about -text About -menu .menu.about.menu
    pack .menu.options -side left
    pack .menu.about -side right
    menu .menu.options.menu
    .menu.options.menu add command -label "New Button" -command "make_button .select" -accelerator "Ctrl+N"
    .menu.options.menu add command -label "Kill Button" -command "kill_button" -accelerator "Ctrl-K"
    .menu.options.menu add command -label "Save Options" -command "save_options" -accelerator "Ctrl-S"
    .menu.options.menu add sep
    .menu.options.menu add checkbutton -label "Save on Exit?" -variable save_on_exit
    .menu.options.menu add sep
    .menu.options.menu add command -label "Exit" -command "exit_proc $userhome" -accelerator "Ctrl-X"
    menu .menu.about.menu
    .menu.about.menu add command -label About -command "about_box"
    pack .menu -side top -fill x
    tk_menuBar .menu
    bind .select <Shift-2> "make_button %W"
    pack .select
    button .select.exit -text "Exit/Lock" -command "exit_proc $userhome"
    bind .select.exit <3> "get_lock_password"
    bind all <Control-n> "make_button .select"
    bind all <Control-k> kill_button
    bind all <Control-s> save_options
    bind all <Control-a> save_as
    bind all <Control-x> exit_proc
 
    pack .select.exit -side left -padx 3
    set button_list {}
    for {set i 1} {$i < $number_button} {incr i} {
	lappend button_list [lindex $values(.select.$i) 0]
    }
    set button_on 1
    foreach i $button_list {
	button .select.$button_on -text "$i" 
	bind .select.$button_on <1>  "check_pass_value %W"
	bind .select.$button_on <Shift-2> "remove_button %W"
	bind .select.$button_on <3> "config_button %W"
	pack .select.$button_on -side left -padx 1
	incr button_on
    }
    wm title . [format "tkTelnet v%s" $version]
    wm geometry . +110+200
}

proc find_program {} {
    global program_path full_path

    foreach i [split $full_path :] {
	if [file exists "$i/tkTelrun.tcl"] {
	    set program_path "$i/tkTelrun.tcl"
	    return;
	}
    }
    if [file exists "./tkTelrun.tcl"] {
	set program_path "./tkTelrun.tcl"
	return;
    }
    error_box "tkTelrun.tcl was not found! Please verify it exists and run tkTelnet again." "destroy ."
}
proc error_box {the_text command} {
    catch {destroy .error}
    toplevel .error
    message .error.msg -text "$the_text" -width 300
    button .error.ok -text "OK" -command $command 
    pack .error.msg
    pack .error.ok -fill x -side bottom
    wm title .error Error
    set main_geo [wm geometry .]
    wm geometry .error =$main_geo
 
}    
proc kill_button {} {
    catch {destroy .kill}
    toplevel .kill
    message .kill.msg -text "Click the SECOND button on the button you wish to kill."
    pack .kill.msg  
    wm title .kill "Kill Msg"
}

proc about_box {} {
    global version
    catch {destroy .about}
    toplevel .about
    wm title .about About
    message .about.lbl -text "tkTelnet v$version.  Programmed by Yatish Patel with help from Ashish Desai."
    button .about.ok -text Ok -command "destroy .about"
    pack .about.lbl -side top
    pack .about.ok -side bottom -fill x
}
proc save_options {} {
    global values number_button save_on_exit userhome locked
    if {$locked==1} {
	return
    }
    set config [open "$userhome/.tkTelrc" w]
    set button_number 1
    set number_button [expr $number_button-1]
    puts $config "\# tkTelnet Configuration file. Please do not edit."
    puts $config "save_on_exit = $save_on_exit"
    puts $config "number_of_buttons = $number_button"
    for {set button_number 1} {$button_number <= $number_button} {incr button_number} {
	set button_name_t ".select.$button_number"
	set button_value [lindex $values($button_name_t) 0] 
	set hostname_value  [lindex $values($button_name_t) 1]
	set loginname_value [lindex $values($button_name_t) 2]
        set telnet_type [lindex $values($button_name_t) 4]
	puts $config "button_name = $button_value"
	puts $config "hostname_value = $hostname_value"
	puts $config "login_value = $loginname_value"
	puts $config "telnet_type = $telnet_type"
    }
    close $config
}    
proc exit_proc {userhome} {
    global values number_button save_on_exit locked
    if {$save_on_exit==1} {
	save_options
    }
    destroy .
}
proc open_config {userhome} {
    global values number_button save_on_exit
    if [file exists "$userhome/.tkTelrc"] {
	set config [open "$userhome/.tkTelrc" r]
    } else {
	set config [open "$userhome/.tkTelrc" w]
	puts $config "\# tkTelnet Configuration file.  Please do not edit."
	puts $config "save_on_exit = 1"
	puts $config "number_of_buttons = 1"
	puts $config "button_name = Ernie"
	puts $config "hostname_value = ernie"
	puts $config "login_value = yatish"
	puts $config "telnet_type = login:"
	close $config
	set config [open "$userhome/.tkTelrc" r]
    }
    gets $config line
    gets $config line
    set save_on_exit [lindex $line 2]
    gets $config line
    set number_of_buttons [lindex $line 2]
    for {set button_number 1} {$button_number <= $number_of_buttons} {incr button_number} {
	gets $config button_name
	set button_name [lindex $button_name 2]
        gets $config hostname_value
	set hostname_value [lindex $hostname_value 2]
	gets $config login_value
	set login_value [lindex $login_value 2]
	gets $config telnet_type
	set telnet_type [lindex $telnet_type 2]
	set values(.select.$button_number) [format "%s %s %s none %s" $button_name $hostname_value $login_value  $telnet_type]
    }
    close $config
    set number_button [expr $number_of_buttons+1]
}
find_program
open_config $userhome
unlock

proc remove_button {button_name} {
    global number_button values
    catch {destroy $button_name}
    catch {destroy .kill}
    set number_button [expr $number_button-1]
    set button_on 1
    foreach i [array names values] {
	if {[string compare $i $button_name]==0} {
	} else {
	    set next_values(.select.$button_on) $values($i)
	    incr button_on
	}
    }
    foreach i [array names next_values] {
	set values($i) $next_values($i)
    }
}
proc get_lock_password {} {
    global something
    set something  ""
    destroy .select
    frame .select
    label .select.label -text "Enter Lock Password:"
    entry .select.entry -textvariable something -show * -relief sunken
    pack .select.label -side left
    pack .select.entry -side left
    pack .select
    focus .select.entry
    bind .select.entry <Return> "lock"
}

proc lock {} {
    global something locked
    set locked 1
    set orother ""
    destroy .select
    frame .select
    label .select.label -text "Password:"
    entry .select.entry -textvariable orother -show * -relief sunken
    pack .select.label -side left
    pack .select.entry -side left
    pack .select
    focus .select.entry
    bind .select.entry <Return> "check_pass"
}    
proc check_pass_value {button_name_t} {
    global values something keepit button_name
    set button_name $button_name_t
    set something [lindex $values($button_name) 3]
    set keepit 0
    if {[string compare $something "none"]==0} {
	set something ""
	catch {destroy .password}
	toplevel .password
	frame .password.p
	frame .password.radio
	label .password.p.label -text Password:
	entry .password.p.entry -textvariable something -show * -relief sunken
	label .password.radio.label -text "Remember Password?"
        radiobutton .password.radio.yes -text Yes -variable keepit -value 1
        radiobutton .password.radio.no -text No -variable keepit -value 0
	pack .password.radio.label .password.radio.yes .password.radio.no -side left
	pack .password.p.entry .password.p.label -side right
	pack .password.p
	pack .password.radio -side bottom
	focus .password.p.entry
	bind .password.p.entry <Return> "telnet_proc"
    } else {
	telnet_proc
    }        set hostname [lindex $values($button_name) 1]


}
proc check_pass {} {
    global something orother locked
 if {[string compare $something $orother]== 0} {
       set unlockpass ""
       set locked 0
       unlock
 }
}

proc telnet_proc {} {
	global values button_name infor something keepit userhome program_path
        global number_buttons
        catch {destroy .password}
#	set button_name $button_name_t
        set f [ open "$userhome/.tkTeldat" w]
        set hostname [lindex $values($button_name) 1]
    if {$keepit==1} {
	set values($button_name) [lreplace $values($button_name) 3 3 $something] 
	puts $f $values($button_name)
    } else {
	puts $f [format "%s %s %s %s %s" [lindex $values($button_name) 0] $hostname [lindex $values($button_name) 2] $something [lindex $values($button_name) 4]] 

    }
	close $f
    spawn -noecho /usr/local/X11/bin/xterm -T $hostname -e $program_path
    set f [open "$userhome/tkTeldat" w]
    puts $f "tkTelnet Data file. Do not touch!"
    close $f
    sleep 2
    if [file exists "$userhome/.tkTelerror"] {
	set f [open "$userhome/.tkTelerror" r]
	gets $f line
	if {[string compare $line "Unknown Host"]==0} {
	    error_box "Hostname: $hostname, was not found." "destroy .error"
	}
	if {[string compare $line "Connection Timed Out"]==0} {
	    error_box "Connection Timed Out" "destroy .error"
	}
	close $f
	set f [open "$userhome/.tkTelerror" w]
	puts $f "tkTelrun.tcl Error File."
	close $f
    }

}

proc make_button {frame_name} {
    global number_button values
    set button_name "$frame_name.$number_button"
    set values($button_name) {Session session login none login:}
    button $frame_name.$number_button -text "session"
    bind $frame_name.$number_button <1> "check_pass_value %W"
    bind $frame_name.$number_button <Shift-2> "remove_button %W"
    bind $frame_name.$number_button <3> "config_button %W"
    pack $frame_name.$number_button -side left -padx 1
    incr number_button
}

proc config_button {button_name_t} {
 global button_name button_value hostname_value loginname_value values
 global passwd_value button_list telnet_type


   	set button_name $button_name_t
	catch {destroy .config}
	toplevel .config 
	set button_value [lindex $values($button_name_t) 0] 
	set hostname_value  [lindex $values($button_name_t) 1]
	set loginname_value [lindex $values($button_name_t) 2]
	set passwd_value [lindex $values($button_name_t) 3]
        set telnet_type [lindex $values($button_name_t) 4]
	frame .config.labels	
	frame .config.entrys
        frame .config.radio
	frame .config.buttons
	label .config.labels.button_l -text "Button Name" 
	entry .config.entrys.button  -textvariable button_value -relief sunken 
	label .config.labels.host_l -text "Host Name"
	entry .config.entrys.host  -textvariable hostname_value -relief sunken
	label .config.labels.login_l -text "Login "
	entry .config.entrys.login  -textvariable loginname_value -relief sunken
	label .config.labels.passwd_l -text "Passwd "
	entry .config.entrys.passwd -text "Password:" -textvariable passwd_value -relief sunken -show *
        button .config.buttons.finish -text "finish" -command {set_button_val;destroy .config}
	bind .config <Return> {set_button_val;destroy .config}
        label .config.radio.label -text "Telnet Type:"
        radiobutton .config.radio.yes -text SRA -variable telnet_type -value User
    radiobutton .config.radio.no -text normal  -variable telnet_type -value login:
	pack .config.buttons.finish -side left -fill x
	pack .config.labels.passwd_l -side bottom
	pack .config.entrys.passwd -side bottom
	pack .config.labels.login_l -side bottom
	pack .config.entrys.login  -side bottom
	pack .config.entrys.host  -side bottom                     
	pack .config.labels.host_l  -side bottom
        pack .config.radio.label .config.radio.yes .config.radio.no -side left
	pack .config.entrys.button  -side bottom
	pack .config.labels.button_l -side bottom
	pack .config.buttons -side bottom
        pack .config.radio -side bottom
    pack .config.entrys -side right
	pack .config.labels -side left
} 

proc set_button_val {} {
 global button_name button_value hostname_value loginname_value passwd_value values telnet_type
 $button_name configure -text  $button_value 
    set values($button_name)  [format "%s %s %s %s %s" $button_value $hostname_value $loginname_value $passwd_value $telnet_type]
 }
