#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"
# -*- Mode: Tcl -*-

###############################
# 
# tkcomm
# 
# Manager for Telnet- and other adresses 
# 
# Copyright: Steffen Leich 1997 (leich@wiwi.uni-marburg.de)
# 
###############################
# Visual Tcl v1.10 Project
#

#################################
# GLOBAL VARIABLES
#
global action; 
global background; 
global fontvar; 
global foreground; 
global sites; 
global terminal; 
global widget; 

#################################
# USER DEFINED PROCEDURES
#
proc init {argc argv} {
    global env action background foreground fontvar terminal
    if {[file exists "$env(HOME)/.tkcomm"]} {
	source "$env(HOME)/.tkcomm"
    } else {
	set background Blue
	set foreground White
	set fontvar 8x13
	set terminal xterm
    }
    set action telnet
}

init $argc $argv


proc action {} {
    global action background foreground fontvar terminal sites
    set sitename [.top17.cpd18.01 get active]
    set site $sites($sitename)

    array set procs \
	{telnet telnet www lynx ftp ncftp ping ping rlogin rlogin}

    exec $terminal -fn $fontvar -bg $background \
	-fg $foreground -title "$action on $sitename" \
	-e $procs($action) $site &
}

proc ask_exit {} {
    if {[tk_messageBox -title "Exit?" -type yesno \
	    -default no  -message "Exit TkComm?" \
	    -icon question] == "yes"} {
	exit
    }
}

proc configs {mode} {
    global env background foreground fontvar terminal
    switch -exact $mode {
	1 {
	    Window show .top39
	}
	2 {
	    set cf [open "$env(HOME)/.tkcomm" w]
	    foreach conf {background foreground fontvar terminal} {
		puts $cf "set $conf [set $conf]"
	    }
	    close $cf
	    Window destroy .top39
	}
    }
}

proc delete_site {} {
    global sites env
    if {[tk_messageBox -title "Delete?" -type yesno \
	    -default no -message "Delete [.top17.cpd18.01 get active]?" \
	    -icon question] == "yes"} {
	unset sites([.top17.cpd18.01 get active])
	.top17.cpd18.01 delete active
	set sitesf [open "$env(HOME)/.tkcomm_sites" w]
	foreach s [array names sites] {
	    puts $sitesf "$sites($s)\#$s"
	}
	close $sitesf
	return
    } else {
	return
    }
}

proc props {mode} {
    global env sites
    switch -exact -- $mode {
	1 {
	    Window show .top38
	    wm title .top38 "New entry"
	}
	2 {
	    Window show .top38
	    .top38.fra19.ent22 insert 0 [.top17.cpd18.01 get active]
	    .top38.fra19.ent24 insert 0 $sites([.top17.cpd18.01 get active])
	}
	3 {
	    set name [.top38.fra19.ent22 get] 
	    set addr [.top38.fra19.ent24 get]
	    if {[wm title .top38] != "Properties"} {
		foreach ts [array names sites] {
		    if {$ts == $name} {
			.top17.fra25.lab26 config -text \
			    "Already have an entry named $name"
			return
		    }
		}
	    }
	    if {[wm title .top38] == "Properties"} {
		unset sites([.top17.cpd18.01 get active])
	    }
	    set sitesf [open "$env(HOME)/.tkcomm_sites" w]
	    set sites([.top38.fra19.ent22 get]) [.top38.fra19.ent24 get] 
	    foreach s [array names sites] {
		puts $sitesf "$sites($s)\#$s"
	    }
	    close $sitesf
	    Window destroy .top38
	    .top17.cpd18.01 delete 0 end
	    foreach ns [array names sites] {
		.top17.cpd18.01 insert end $ns
	    }
	}
    }
}

proc status {X Y} {
    global sites
    .top17.fra25.lab26 config -text $sites([.top17.cpd18.01 get @$X,$Y])
}

proc main {argc argv} {
    global env sites
    if [file exists "$env(HOME)/.tkcomm_sites"] {
	set sitesf [open "$env(HOME)/.tkcomm_sites" r]
	while {[gets $sitesf site] > 0} {
	    set sites([lindex [split $site \#] 1]) [lindex [split $site \#] 0]
	    .top17.cpd18.01 insert end [lindex [split $site \#] 1] 
	}
	close $sitesf
	.top17.cpd18.01 selection set 0
    }
}

proc about {} {
    if {[.top17.fra34.lab18 cget -text] == "TkComm"} {
	.top17.fra34.lab18 config -text \
		"by Steffen Leich 1997"
    } else {
	.top17.fra34.lab18 config -text "TkComm"
    }
}

proc Window {args} {
    global vTcl
    set cmd [lindex $args 0]
    set name [lindex $args 1]
    set newname [lindex $args 2]
    set rest [lrange $args 3 end]
    if {$name == "" || $cmd == ""} {return}
    if {$newname == ""} {
        set newname $name
    }
    set exists [winfo exists $newname]
    switch $cmd {
        show {
            if {$exists == "1" && $name != "."} {wm deiconify $name; return}
            if {[info procs vTclWindow(pre)$name] != ""} {
                eval "vTclWindow(pre)$name $newname $rest"
            }
            if {[info procs vTclWindow$name] != ""} {
                eval "vTclWindow$name $newname $rest"
            }
            if {[info procs vTclWindow(post)$name] != ""} {
                eval "vTclWindow(post)$name $newname $rest"
            }
        }
        hide    { if $exists {wm withdraw $newname; return} }
        iconify { if $exists {wm iconify $newname; return} }
        destroy { if $exists {destroy $newname; return} }
    }
}

#################################
# VTCL GENERATED GUI PROCEDURES
#

proc vTclWindow. {base} {
    if {$base == ""} {
        set base .
    }
    ###################
    # CREATING WIDGETS
    ###################
    wm focusmodel $base passive
    wm geometry $base 1x1+0+0
    wm maxsize $base 1009 738
    wm minsize $base 1 1
    wm overrideredirect $base 0
    wm resizable $base 1 1
    wm withdraw $base
    wm title $base "vt.tcl"
    ###################
    # SETTING GEOMETRY
    ###################
}

proc vTclWindow.top17 {base} {
    if {$base == ""} {
        set base .top17
    }
    if {[winfo exists $base]} {
        wm deiconify $base; return
    }
    ###################
    # CREATING WIDGETS
    ###################
    toplevel $base -class Toplevel \
        -borderwidth "4" 
    wm focusmodel $base passive
    wm minsize $base 1 1
    wm overrideredirect $base 0
    wm deiconify $base
    wm title $base "TkComm"
    frame $base.cpd18 \
        -borderwidth "1" -height "30" -relief "raised" -width "30" 
    listbox $base.cpd18.01 \
        -background "#fefefe" \
        -font "Helvetica 12" -width 30 \
        -selectbackground "#225ed8" -selectforeground "#fefefe" \
        -xscrollcommand ".top17.cpd18.02 set" \
        -yscrollcommand ".top17.cpd18.03 set" 
    bind $base.cpd18.01 <Button-1> {
        status %x %y
    }
    bind $base.cpd18.01 <Double-Button-1> {
        action
    }
    scrollbar $base.cpd18.02 \
        -borderwidth "1" -command ".top17.cpd18.01 xview" -orient "horiz" \
        -width "10" 
    scrollbar $base.cpd18.03 \
        -borderwidth "1" -command ".top17.cpd18.01 yview" -orient "vert" \
        -width "10" 
    frame $base.fra25 \
        -borderwidth "2" -height "75" -relief "groove" -width "128" 
    label $base.fra25.lab26 \
        -anchor "w" -borderwidth "0" -font "Helvetica -12 {}"
    frame $base.fra34 \
        -borderwidth "2" -height "75" -relief "groove" -width "125" 
    frame $base.fra34.fra35 \
        -borderwidth "2" -height "75" -width "125" 
    button $base.fra34.fra35.01 \
        -command "props 1" -font "Helvetica -12 {}" -padx "9" -pady "3" \
        -text "New" 
    button $base.fra34.fra35.02 \
        -command "props 2" -font "Helvetica -12 {}" -padx "9" -pady "3" \
        -text "Props" 
    button $base.fra34.fra35.03 \
        -command "delete_site" -font "Helvetica -12 {}" -padx "9" -pady "3" \
        -text "Delete" 
    button $base.fra34.fra35.04 \
        -command "configs 1" -font "Helvetica -12 {}" -padx "9" -pady "3" \
        -text "Config" 
    button $base.fra34.fra35.but37 \
        -command "ask_exit" -font "Helvetica -12 {}" -padx "9" -pady "3" \
        -text "Exit" 
    frame $base.fra34.fra36 \
        -borderwidth "2" -height "75" -width "125" 

    foreach \
	name "$base.fra34.fra36.01 $base.fra34.fra36.02 \
	     $base.fra34.fra36.03 $base.fra34.fra36.04 $base.fra34.fra36.rad17" \
	text {Rlogin WWW Ping Ftp Telnet} \
	value {rlogin www ping ftp telnet} {
	    radiobutton $name \
		-font "Helvetica -12 {}" -indicatoron "0" -selectcolor "#225ed8" \
		-text $text -value $value -variable "action" 
	}
    
    button $base.fra34.fra36.05 \
        -command "action" -font "Helvetica -12 {bold italic}" -padx "9" \
        -pady "3" -text "Execute" 
    label $base.fra34.lab18 \
        -background "#205ddf" -borderwidth "1" -font "Helvetica 12" \
        -foreground "#ffffff" -relief "raised" -text "TkComm"
    bind $base.fra34.lab18 <Button-1> {
        about
    }
    ###################
    # SETTING GEOMETRY
    ###################
    grid columnconf $base 0 -weight 1
    grid rowconf $base 0 -weight 1
    grid $base.cpd18 \
        -in ".top17" -column "0" -row "0" -columnspan "1" -rowspan "2" \
        -ipadx "2" -ipady "2" -padx "2" -pady "2" -sticky "nesw" 
    grid columnconf $base.cpd18 0 -weight 1
    grid rowconf $base.cpd18 0 -weight 1
    grid $base.cpd18.01 \
        -in ".top17.cpd18" -column "0" -row "0" -columnspan "1" -rowspan "1" \
        -sticky "nesw" 
    grid $base.cpd18.02 \
        -in ".top17.cpd18" -column "0" -row "1" -columnspan "1" -rowspan "1" \
        -sticky "ew" 
    grid $base.cpd18.03 \
        -in ".top17.cpd18" -column "1" -row "0" -columnspan "1" -rowspan "1" \
        -sticky "ns" 
    grid $base.fra25 \
        -in ".top17" -column "0" -row "2" -columnspan "2" -rowspan "1" \
        -ipadx "2" -ipady "2" -padx "2" -pady "2" -sticky "ew" 
    grid columnconf $base.fra25 0 -weight 1
    grid $base.fra25.lab26 \
        -in ".top17.fra25" -column "0" -row "0" -columnspan "1" -rowspan "1" \
        -sticky "ew" 
    grid $base.fra34 \
        -in ".top17" -column "1" -row "0" -columnspan "1" -rowspan "1" \
        -ipadx "2" -ipady "2" -padx "2" -pady "2" -sticky "n" 
    grid columnconf $base.fra34 1 -weight 1
    grid rowconf $base.fra34 0 -weight 1
    grid $base.fra34.fra35 \
        -in ".top17.fra34" -column "1" -row "0" -columnspan "1" -rowspan "1" \
        -ipadx "2" -ipady "2" -padx "2" -pady "2" -sticky "new" 
    grid columnconf $base.fra34.fra35 0 -weight 1
    grid $base.fra34.fra35.01 \
        -in ".top17.fra34.fra35" -column "0" -row "0" -columnspan "1" \
        -rowspan "1" -sticky "ew" 
    grid $base.fra34.fra35.02 \
        -in ".top17.fra34.fra35" -column "0" -row "1" -columnspan "1" \
        -rowspan "1" -sticky "ew" 
    grid $base.fra34.fra35.03 \
        -in ".top17.fra34.fra35" -column "0" -row "2" -columnspan "1" \
        -rowspan "1" -sticky "ew" 
    grid $base.fra34.fra35.04 \
        -in ".top17.fra34.fra35" -column "0" -row "3" -columnspan "1" \
        -rowspan "1" -sticky "ew" 
    grid $base.fra34.fra35.but37 \
        -in ".top17.fra34.fra35" -column "0" -row "4" -columnspan "1" \
        -rowspan "1" -sticky "ew" 
    grid $base.fra34.fra36 \
        -in ".top17.fra34" -column "0" -row "0" -columnspan "1" -rowspan "1" \
        -ipadx "2" -ipady "2" -padx "2" -pady "2" -sticky "new" 
    grid columnconf $base.fra34.fra36 0 -weight 1
    grid $base.fra34.fra36.01 \
        -in ".top17.fra34.fra36" -column "0" -row "1" -columnspan "1" \
        -rowspan "1" -sticky "ew" 
    grid $base.fra34.fra36.02 \
        -in ".top17.fra34.fra36" -column "0" -row "2" -columnspan "1" \
        -rowspan "1" -sticky "ew" 
    grid $base.fra34.fra36.03 \
        -in ".top17.fra34.fra36" -column "0" -row "3" -columnspan "1" \
        -rowspan "1" -sticky "ew" 
    grid $base.fra34.fra36.04 \
        -in ".top17.fra34.fra36" -column "0" -row "4" -columnspan "1" \
        -rowspan "1" -sticky "ew" 
    grid $base.fra34.fra36.05 \
        -in ".top17.fra34.fra36" -column "0" -row "5" -columnspan "2" \
        -rowspan "1" -sticky "ew" 
    grid $base.fra34.fra36.rad17 \
        -in ".top17.fra34.fra36" -column "0" -row "0" -columnspan "1" \
        -rowspan "1" -sticky "ew" 
    grid $base.fra34.lab18 \
        -in ".top17.fra34" -column "0" -row "1" -columnspan "2" -rowspan "1" \
        -sticky "ew" 
}

proc vTclWindow.top38 {base} {
    if {$base == ""} {
        set base .top38
    }
    if {[winfo exists $base]} {
        wm deiconify $base; return
    }
    ###################
    # CREATING WIDGETS
    ###################
    toplevel $base -class Toplevel \
        -borderwidth "4" 
    wm focusmodel $base passive
    wm geometry $base +[winfo pointerx .]+[winfo pointery .]
    wm minsize $base 1 1
    wm overrideredirect $base 0
    wm title $base "Properties"
    grab $base
    frame $base.fra19 \
        -borderwidth "2" -height "75" -relief "groove" -width "125" 
    label $base.fra19.lab21 \
        -anchor "w" -borderwidth "0" -font "Helvetica -12 {}" \
        -relief "raised" -text "Name:" 
    entry $base.fra19.ent22\
        -background "#fefefe" -width "25" 
    label $base.fra19.lab23 \
        -anchor "w" -borderwidth "0" -font "Helvetica -12 {}" \
        -relief "raised" -text "Address:" 
    entry $base.fra19.ent24 \
        -background "#fefefe" -width "25"
    frame $base.fra20 \
        -borderwidth "2" -height "75" -relief "groove" -width "125" 
    button $base.fra20.but27 \
        -command "Window destroy .top38" -font "Helvetica -12 {}" -padx "9" \
        -pady "3" -text "Close" 
    button $base.fra20.but28 \
        -command "props 3" -font "Helvetica -12 {}" -padx "9" -pady "3" \
        -text "Save" 
    ###################
    # SETTING GEOMETRY
    ###################
    grid columnconf $base 0 -weight 1
    grid rowconf $base 0 -weight 1
    grid $base.fra19 \
        -in ".top38" -column "0" -row "0" -columnspan "1" -rowspan "1" \
        -ipadx "2" -ipady "2" -padx "2" -pady "2" -sticky "nesw" 
    grid columnconf $base.fra19 1 -weight 1
    grid $base.fra19.lab21 \
        -in ".top38.fra19" -column "0" -row "0" -columnspan "1" -rowspan "1" \
        -padx "2" -sticky "ew" 
    grid $base.fra19.ent22 \
        -in ".top38.fra19" -column "1" -row "0" -columnspan "1" -rowspan "1" \
        -padx "2" -sticky "ew" 
    grid $base.fra19.lab23 \
        -in ".top38.fra19" -column "0" -row "1" -columnspan "1" -rowspan "1" \
        -padx "2" -sticky "ew" 
    grid $base.fra19.ent24 \
        -in ".top38.fra19" -column "1" -row "1" -columnspan "1" -rowspan "1" \
        -padx "2" -sticky "ew" 
    grid $base.fra20 \
        -in ".top38" -column "0" -row "1" -columnspan "1" -rowspan "1" \
        -ipadx "2" -ipady "2" -padx "2" -pady "2" -sticky "ew" 
    grid $base.fra20.but27 \
        -in ".top38.fra20" -column "0" -row "0" -columnspan "1" -rowspan "1" 
    grid $base.fra20.but28 \
        -in ".top38.fra20" -column "1" -row "0" -columnspan "1" -rowspan "1" 
}

proc vTclWindow.top39 {base} {
    if {$base == ""} {
        set base .top39
    }
    if {[winfo exists $base]} {
        wm deiconify $base; return
    }
    ###################
    # CREATING WIDGETS
    ###################
    toplevel $base -class Toplevel \
        -borderwidth "4" 
    wm focusmodel $base passive
    wm geometry $base +[winfo pointerx .]+[winfo pointery .]
    wm minsize $base 1 1
    wm overrideredirect $base 0
    wm title $base "Config"
    frame $base.fra30 \
        -borderwidth "2" -height "75" -relief "groove" -width "125" 
    frame $base.fra30.fra17 \
        -borderwidth "2" -height "75" -relief "groove" -width "125" 

    menubutton $base.fra30.fra17.men18 \
        -anchor "w" -font "Helvetica -12 {}" -indicatoron "1" \
        -menu ".top39.fra30.fra17.men18.01" -padx "4" -pady "3" \
        -relief "raised" -text "Black" -textvariable "background" 
    menu $base.fra30.fra17.men18.01 \
        -cursor "" -font "Helvetica -12" -tearoff "0" 
    foreach label {Red Green Blue White Black} {
	$base.fra30.fra17.men18.01 add radiobutton \
	    -label $label -state "active" -value $label -variable "background"
    }

    menubutton $base.fra30.fra17.men19 \
        -anchor "w" -font "Helvetica -12 {}" -indicatoron "1" \
        -menu ".top39.fra30.fra17.men19.01" -padx "4" -pady "3" \
        -relief "raised" -text "Green" -textvariable "foreground" 
    menu $base.fra30.fra17.men19.01 \
        -cursor "" -font "Helvetica -12" -tearoff "0" 
    foreach label {Red Green Blue White Black} {
	$base.fra30.fra17.men19.01 add radiobutton \
	    -label $label -state "active" -value $label -variable "foreground"
    }

    menubutton $base.fra30.fra17.men20 \
        -anchor "w" -font "Helvetica -12 {}" -indicatoron "1" \
        -menu ".top39.fra30.fra17.men20.01" -padx "4" -pady "3" \
        -relief "raised" -text "8x13" -textvariable "fontvar" 
    menu $base.fra30.fra17.men20.01 \
        -cursor "" -font "Helvetica -12" -tearoff "0" 
    foreach label {5x7 5x8 6x9 6x10 6x12 6x13 6x13bold 7x13 7x13bold \
		      7x14 7x14bold 8x13 8x13bold 8x16 9x15 9x15bold 10x20} {	  
			  $base.fra30.fra17.men20.01 add radiobutton \
			      -label $label -value $label -variable "fontvar"
		      }
    
    label $base.fra30.fra17.lab26 \
        -anchor "w" -borderwidth "1" -font "Helvetica -12 {}" \
        -text "Foreground:" 
    label $base.fra30.fra17.lab27 \
        -anchor "w" -borderwidth "1" -font "Helvetica -12 {}" \
        -text "Background:" 
    label $base.fra30.fra17.lab28 \
        -anchor "w" -borderwidth "1" -font "Helvetica -12 {}" -text "Font:" 
    frame $base.fra30.fra21 \
        -borderwidth "2" -height "75" -relief "groove" -width "125" 
    radiobutton $base.fra30.fra21.rad24 \
        -anchor "w" -font "Helvetica -12 {}" -text "Xterm" -value "xterm" \
        -variable "terminal" 
    radiobutton $base.fra30.fra21.rad25 \
        -anchor "w" -font "Helvetica -12 {}" -text "rxvt" -value "rxvt" \
        -variable "terminal" 
    frame $base.fra31 \
        -borderwidth "2" -height "75" -relief "groove" -width "125" 
    button $base.fra31.but32 \
        -command "Window destroy .top39" -font "Helvetica -12 {}" -padx "9" \
        -pady "3" -text "Close" 
    button $base.fra31.but33 \
        -command "configs 2" -font "Helvetica -12 {}" -padx "9" -pady "3" \
        -text "Save" 
    ###################
    # SETTING GEOMETRY
    ###################
    grid columnconf $base 0 -weight 1
    grid rowconf $base 0 -weight 1
    grid $base.fra30 \
        -in ".top39" -column "0" -row "0" -columnspan "1" -rowspan "1" \
        -ipadx "2" -ipady "2" -padx "2" -pady "2" -sticky "nesw" 
    grid columnconf $base.fra30 0 -weight 1
    grid rowconf $base.fra30 3 -weight 1
    grid rowconf $base.fra30 4 -weight 1
    grid $base.fra30.fra17 \
        -in ".top39.fra30" -column "0" -row "3" -columnspan "1" -rowspan "1" \
        -ipadx "2" -ipady "2" -padx "2" -pady "2" -sticky "new" 
    grid columnconf $base.fra30.fra17 0 -weight 1
    grid $base.fra30.fra17.men18 \
        -in ".top39.fra30.fra17" -column "0" -row "5" -columnspan "1" \
        -rowspan "1" -sticky "ew" 
    grid $base.fra30.fra17.men19 \
        -in ".top39.fra30.fra17" -column "0" -row "3" -columnspan "1" \
        -rowspan "1" -sticky "ew" 
    grid $base.fra30.fra17.men20 \
        -in ".top39.fra30.fra17" -column "0" -row "1" -columnspan "1" \
        -rowspan "1" -sticky "ew" 
    grid $base.fra30.fra17.lab26 \
        -in ".top39.fra30.fra17" -column "0" -row "2" -columnspan "1" \
        -rowspan "1" -sticky "ew" 
    grid $base.fra30.fra17.lab27 \
        -in ".top39.fra30.fra17" -column "0" -row "4" -columnspan "1" \
        -rowspan "1" -sticky "ew" 
    grid $base.fra30.fra17.lab28 \
        -in ".top39.fra30.fra17" -column "0" -row "0" -columnspan "1" \
        -rowspan "1" -sticky "ew" 
    grid $base.fra30.fra21 \
        -in ".top39.fra30" -column "0" -row "4" -columnspan "1" -rowspan "1" 
    grid columnconf $base.fra30.fra21 0 -weight 1
    grid $base.fra30.fra21.rad24 \
        -in ".top39.fra30.fra21" -column "0" -row "1" -columnspan "1" \
        -rowspan "1" -sticky "ew" 
    grid $base.fra30.fra21.rad25 \
        -in ".top39.fra30.fra21" -column "0" -row "2" -columnspan "1" \
        -rowspan "1" -sticky "ew" 
    grid $base.fra31 \
        -in ".top39" -column "0" -row "1" -columnspan "1" -rowspan "1" \
        -ipadx "2" -ipady "2" -padx "2" -pady "2" -sticky "ew" 
    grid $base.fra31.but32 \
        -in ".top39.fra31" -column "0" -row "0" -columnspan "1" -rowspan "1" 
    grid $base.fra31.but33 \
        -in ".top39.fra31" -column "1" -row "0" -columnspan "1" -rowspan "1" 
}

Window show .
Window show .top17

main $argc $argv
