#!/usr/local/bin/wish -f

# configuration:

set iconloc /home/bri/shell/tkph.icon
set ph /usr/local/bin/ph
set phserver "ural.ethz.ch"
set phserver "ph.psu.edu"
set phserver "info.risc.uni-linz.ac.at"

set numfields "2"
set field1 "field1"
set field2 "field2"

set listField "name"

# set pageup "R9"
# set pagedown "R15"

set pageup "Prior"
set pagedown "Next"

#
# - end of configuration
#

set listmode "true"
set cur_change_field ""
set curlistindex 0
set outgoing ""

if {[lindex $argv 0] != ""} {
    set phserver "[lindex $argv 0]"
}

set phopts "lmqbrn"

set rfield1 "field1"
set rfield2 "field2"

proc tkerror {err} {
    global errorInfo
    if {$err != {}} {
	puts stdout $errorInfo
    }
}

wm iconbitmap . "@$iconloc"
wm minsize . 80 10
wm maxsize . 80 200

global tempvar ; set tempvar "off"
set return_code ""

set ct .control
set ot .output
set otq $ot.queryOutput

frame $ct
pack $ct -anchor e -side top -fill x

#
# menu
#

frame $ct.menu -relief raised -borderwidth 2
 pack $ct.menu -side top -pady 2 -fill x
menubutton $ct.menu.opt -text "Options" -menu .control.menu.opt.m -underline 0

menu $ct.menu.opt.m
     $ct.menu.opt.m add check -label "List Mode" -variable \
	 listmode -offvalue "false"  -onvalue "true" \
	 -command "act-listm $otq"
     $ct.menu.opt.m add command -label "Log in.." -command "mkinitlogin $otq"
     $ct.menu.opt.m add command -label "(Re)connect.." \
         -command "mkserver $otq"

pack $ct.menu.opt -side left -in $ct.menu

#
# entry boxen
#

frame $ct.e
 pack $ct.e -side left -pady 2

  frame $ct.e.q
   pack $ct.e.q -side top
   pack configure $ct.e.q -anchor e
  button $ct.e.q.ueryButton -text "Query:" -width 15
  entry $ct.e.q.uery -textvariable query -relief sunken \
	-insertwidth 1 -width 20
  pack \
	$ct.e.q.uery \
	$ct.e.q.ueryButton \
  	 -side right

set foo "field1 field2"
foreach f "$foo" {
    frame $ct.e.$f
    pack $ct.e.$f -side top -anchor e
    button $ct.e.$f.label$f -relief raised -text "[set $f]:" -width 15
    entry $ct.e.$f.$f -textvariable stuff$f -relief sunken \
	-insertwidth 1 -width 20
    pack \
	$ct.e.$f.$f \
	$ct.e.$f.label$f \
	    -side right
    $ct.e.$f.label$f configure -command \
	"mksetfield setfield $f Lookup $otq"
    bind $ct.e.$f.$f <Return> { do-q "ph $query [add_args] $return_code" }
}

bind $ct.e.q.uery <Return> {
  if {[string trim $query] != ""} { do-q "ph $query [add_args] $return_code" }
}

$ct.e.q.ueryButton config -command {
    if {$query != ""} { do-q "ph $query [add_args] $return_code" }
}

bind $ct.e.q.uery <Tab> "focus $ct.e.field1.field1"
bind $ct.e.field1.field1 <Tab> "focus $ct.e.field2.field2"
bind $ct.e.field2.field2 <Tab> "focus $ct.e.q.uery"

#
# other buttons
#

frame $ct.b
 pack $ct.b -side top -pady 2 -anchor ne

button $ct.b.quit -text Exit
set helpVal ""
button $ct.b.helpButton -text "Help"
button $ct.b.statusButton -text "Clear/Status"
button $ct.b.fieldsButton -text "Fields.."

pack $ct.b.quit \
     $ct.b.helpButton \
     $ct.b.statusButton \
     $ct.b.fieldsButton \
	-side right -padx 2

$ct.b.helpButton config \
    -command {do-help "help $helpVal" .output.queryOutput}
# XXX

$ct.b.statusButton config -command {
    set query ""
    do-q "status"
}
$ct.b.fieldsButton config -command "mkfields $otq"
# XXX
$ct.b.quit config -command  "exit-sm"

#
# login
#

frame $ct.login
 pack $ct.login -side top -pady 2 -anchor se

#
# output
#

frame $ot
 pack $ot -pady 3 -expand true -fill y
 scrollbar $ot.q-scrollbar -relief flat -orient vertical \
     -command "$otq yview"
 text $otq -width 80 -relief raised \
     -height 20 -state disabled -yscrollcommand "$ot.q-scrollbar set" \
     -setgrid true -cursor top_left_arrow
 pack $ot.q-scrollbar \
      $otq \
	-side bottom -side right -fill y -padx 3 -expand true

#
# query ksyms
#

if [catch {
    bind $ct.e.q.uery <KeyPress-$pagedown> {
	if [catch {
	    .output.queryOutput.next invoke
	}] {
	    sayErr "number of entries <= 1" zing
	}
    }
    # XXX
    bind $ct.e.q.uery <KeyPress-$pageup> {
	if [catch {
	    .output.queryOutput.prev invoke
	}] {
	    sayErr "number of entries <= 1" zing
	}
    }
}] {
    puts stderr "Warning: keysyms may not be configured."
}

$otq tag configure $ot.q-scrollbar

#
# errors/messages
#

frame .errors
 pack .errors -side bottom -pady 3
 text .errors.errorInfo -width 80 -relief groove -setgrid 0 \
     -height 3 -state disabled -yscrollcommand {.errors.errScrollbar set}
 scrollbar .errors.errScrollbar -relief groove -orient vertical \
     -command ".errors.errorInfo yview"
 pack .errors.errScrollbar \
      .errors.errorInfo \
	-side right -padx 3 -fill y

focus $ct.e.q.uery

proc exit-sm {} { exit }

proc act-listm {w} {
    global listmode max
    if {$listmode} {
	if {$max > 0} { config-list $w }
    } else {
	config-plain $w
    }
}

proc do-q {query} {
    global FD listmode listField listings outgoing max
    set oldnum 1
    set crap ""
    set max 0
    set listings {}
    set outgoing {}

    puts $FD "$query"
    flush $FD
    set crap [get-info $query]

    if {$listmode == "false" || [llength $outgoing] <= 1} {
	config-plain .output.queryOutput
    } else {
	config-list .output.queryOutput
	# XXX
    }

    set max [llength $outgoing]
    incr max -1
}

proc do-help {query w} {
    global FD listmode listField listings outgoing max
    set oldnum 1
    set crap ""
    set max 0
    set listings ""
    set outgoing ""

    puts $FD "$query"
    flush $FD

    zingtext $w 0

    if {[string trim $query] == "help"} {
	$w insert end \
	    "Double click on any of the topics below for more help:\n\n"
	$w tag add sillyTag 1.0 "1.0 lineend"
	$w tag configure sillyTag -underline true
    }

    set helptext [split [get-info $query] "\n"]

    if {[string trim $query] != "help"} {
	button $w.back -text "Back to main help" \
	    -command "do-help help $w"
	$w window create end -window $w.back
	$w insert end "\n"
    }

    foreach line $helptext {
	$w insert end \
	    "[join [lrange [split $line :] 2 end] :]\n"
    }
    $w configure -state disabled
    if {[string trim $query] == "help"} {
	$w tag add helpTag 2.0 end
	$w tag bind helpTag <Double-ButtonRelease-1> {
	    bind .output.queryOutput <1> ""
	    set helpsubj [%W get "@%x,%y wordstart" "@%x,%y wordend"]
	    regsub -all "\n" $helpsubj "" helpsubj
	    do-help "help $helpsubj" %W
	}
    }
    set max 0
    set listings ""
    set outgoing ""
}

proc config-plain {w} {
    global outgoing

    zingtext $w 0
    foreach entry $outgoing {
	$w insert end "$entry"
	$w insert end "\n"
    }
    $w configure -state disabled
}

proc config-list {w} {
    global listings curlistindex

    zingtext $w 0

    button $w.next -text First -command "nent 1 $w"
    button $w.prev -text Last -command "nent -1 $w"
    $w window create end -window $w.next
    $w window create end -window $w.prev

    set eindex 0
    foreach listentry $listings {
	$w insert end "\n$listentry"
	$w tag add otag$eindex "insert linestart" "insert lineend"
	$w tag bind otag$eindex <ButtonRelease-1> "output-entry $eindex $w"
	incr eindex
    }
    $w config -state disabled
    set curlistindex -1
}

proc output-entry {num w} {
    global outgoing curlistindex max

    set imax [expr $max + 1]
    set inum [expr $num + 1]

    zingtext $w 0

    # the back, next, prev buttons
    button $w.next -text Next -command "nent 1 $w"
    button $w.prev -text Prev -command "nent -1 $w"
    button $w.back -text Back -command "config-list $w"

    $w window create end -window $w.next
    $w window create end -window $w.prev
    $w window create end -window $w.back

    $w insert end "\n  Entry $inum (of $imax):\n"
    $w tag add sillyTag 2.2 "2.0 lineend"
    $w tag configure sillyTag -underline true
    $w insert end [lindex $outgoing $num]
    $w configure -state disabled
}

#
# next entry
#

proc nent {incr w} {
	global curlistindex max
	incr curlistindex $incr
	if {$curlistindex > $max} { set curlistindex 0 } else {
	    if {$curlistindex < 0} { set curlistindex $max }
	}
	output-entry $curlistindex $w
}

proc get-info {request} {
    global FD outgoing listings listField max ph phopts phserver

    set crap ""
    set totalerrors ""
    set rc 0
    set max 0
    set oldotherinfo 999
    set oldnum 1
    set first 1
    set nogotRidof 1
    set totalent ""

    while {$rc < 200} {
	set spew [gets $FD]

	set inflist [split $spew ":"]
	set rc [lindex $inflist 0]

	if [eof $FD] {
	    append totalerrors "lost connection to server! Reconnecting...\n"
	    set FD [open "|$ph -$phopts -s $phserver" w+]
	    get-info ""
	    puts $FD "$request"
	    flush $FD
	    set nogotRidof 1
	    catch {destroy .control.login.l}
	}

	if {$spew != ""} {
	    set num [lindex $inflist 1]
	    set linfo [join [lrange $inflist 2 end] ":"]

	    if {[string trim [lindex $inflist 2]] == $listField} {
		if {$first} {
		    set listings [join [lrange $inflist 3 end] ":"]
		} else {
		    lappend listings [join [lrange $inflist 3 end] ":"]
		}
	    }

	    if {$oldnum < $num} {
		if {$first} {
		    set outgoing $totalent
		    set first 0
		} else {
		    lappend outgoing $totalent
		}
		set totalent ""
	    }

	    set oldnum $num

	    if {$rc != 200 && $rc != -200} {
		append totalerrors "$spew\n"
	    } else {
		if {$rc != 200} {
		    append crap "$spew\n"
		    append totalent "$linfo\n"
		}
	    }
	}
    }

    if {$request != "fields"} {
	sayErr $totalerrors zing
    }
    return $crap
}

proc sayErr {stuff zing} {
    .errors.errorInfo configure -state normal
    if {$zing == "zing"} {
	.errors.errorInfo delete 1.0 end
    }
    .errors.errorInfo insert 1.0 $stuff
    .errors.errorInfo configure -state disabled
}

proc hitdef {w f} {
    global return_code default_on
    if {$default_on == "true"} {
	set return_code ""
	config-fieldboxes $w $f
    }
}

proc mkfields {w} {
    global FD return_code f_nothave f_have default_on

    zingtext $w 0

    checkbutton $w.default -text "default" \
	-variable default_on -offvalue "false" -onvalue "true" \
	-command "hitdef $w $w.fields"
    button $w.dismiss -text "Dismiss" -command "zingtext $w 1"

    $w window create end -window $w.default
    $w window create end -window $w.dismiss
    $w insert end "\n"

    frame $w.fields
    set f $w.fields

    frame $f.l
     pack $f.l -side top -fill x
      label $f.l.a -text "Available"
      label $f.l.h -text "Current"
      pack $f.l.a -side left -padx 30
      pack $f.l.h -side right -padx 30

    listbox $f.available -relief sunken -yscrollcommand "$f.ascr set"
    scrollbar $f.ascr -relief sunken -command "$f.available yview"
    listbox $f.thatWeGot -relief sunken -yscrollcommand "$f.gotscr set"
    scrollbar $f.gotscr -relief sunken -command "$f.thatWeGot yview"

    pack $f.ascr \
	 $f.available \
	 $f.thatWeGot \
	 $f.gotscr \
	    -side left -fill y

    $w window create end -window $f

    config-fieldboxes $w $f

    $w configure -state disabled
}

proc config-fieldboxes {w f} {
    global FD return_code f_nothave f_have fdescr listField
    if {$return_code == ""} {
	if {[catch {set fdescr(all)}]} {
	    set f_nothave [lsort [fields-with-props Public]]
	} else {
	    set f_nothave [linsert [lsort [fields-with-props Public]] 0 all]
	}
	set f_have ""
	lreplace f_have 0 0
	$w.default select
    }
    $f.available delete 0 end
    $f.thatWeGot delete 0 end
    eval $f.available insert 0 $f_nothave
    eval $f.thatWeGot insert 0 $f_have
    $f.thatWeGot configure -exportselection false -selectmode single
    $f.available configure -exportselection false -selectmode single

    foreach here_widget {thatWeGot available} {
	bind $f.$here_widget <Motion> {
	    set field_for_info ""
	    %W select clear 0 2000
	    %W select set [%W nearest %y]
	    # XX - hopefully, there aren't more than 2000 fields
	    set windex [%W curselection]
	    if {$windex != ""} {
		set field_for_info [%W get $windex]
	    }
	    if {$field_for_info != ""} {
		sayErr "$field_for_info: $fdescr($field_for_info)" zing
	    }
	}
    }

    bind $f.available <Double-ButtonRelease-1> { }
    bind $f.thatWeGot <Double-ButtonRelease-1> { }

    bind $f.available <ButtonRelease-1> {
	# ick.
	regsub -all ".available" %W "" P
	regsub -all ".fields.available" %W "" PP
	%W select clear 0 2000
	%W select set [%W nearest %y]
	set curindex [%W curselection]
	if {$curindex != ""} {
	    lappend f_have [lindex $f_nothave $curindex]
	    set f_have [lsort $f_have]
	    set f_nothave [lreplace $f_nothave $curindex $curindex]
	    %W delete 0 end
	    $P.thatWeGot delete 0 end
	    eval %W insert 0 $f_nothave
	    eval $P.thatWeGot insert 0 $f_have

	    if {[llength $f_have] != 0} {
		set return_code "return $f_have"
		# this is sort of sleazy
		if {![regexp $listField $return_code]} {
		    append return_code " $listField"
		}
		$PP.default deselect
	    } else {
		set return_code ""
		$PP.default select
		$PP.default flash
	    }
	}
     }

     bind $f.thatWeGot <ButtonRelease-1> {
	# icky.
	regsub -all ".thatWeGot" %W "" P
	regsub -all ".fields.thatWeGot" %W "" PP
	%W select clear 0 2000
	%W select set [%W nearest %y]
	set curindex [%W curselection]
	if {$curindex != ""} {
	    lappend f_nothave [lindex $f_have $curindex]
	    set f_nothave [lsort $f_nothave]
	    set f_have [lreplace $f_have $curindex $curindex]
	    %W delete 0 end
	    $P.available delete 0 end
	    eval %W insert 0 $f_have
	    eval $P.available insert 0 $f_nothave
	    if {[llength $f_have] != 0} {
		set return_code "return $f_have"
		# this is also sort of sleazy
		if {![regexp $listField $return_code]} {
		    append return_code " $listField"
		}
		$PP.default deselect
	    } else {
		$PP.default select
		$PP.default flash
		set return_code ""
	    }
	}
    }
}

proc mksetfield {command field prop w} {
    global FD return_code f_nothave f_have fdescr r$field $field listField
    set tagnum 1

    zingtext $w 0

    $w insert end "Double-click on the new field, or "
    $w tag add uTag 1.0 "1.0 lineend"
    $w tag configure uTag -underline true
    # XXX - that should be a font.

    button $w.cancel -text "Cancel" -command "zingtext $w 1"
    $w window create end -window $w.cancel

    $w insert end "\n"
    set f_nothave [lsort [fields-with-props $prop]]
    foreach new_field "$f_nothave" {
	$w insert end "$new_field"
	$w tag add ftag$tagnum "insert linestart" "insert"
	$w tag bind ftag$tagnum <Motion> \
	    "sayErr \"$new_field: $fdescr($new_field)\" zing"
	# that is why I don't like tcl.
	$w tag bind ftag$tagnum <Double-ButtonRelease-1> \
	    "$command $field $new_field $w"
	$w insert end "\n"
	incr tagnum
    }
    $w configure -state disabled
}

proc zingtext {w disable} {
    $w configure -state normal
    $w delete 1.0 end
    if {$disable} {
	$w configure -state disabled
    }
}

proc addText {w text} {
    zingtext $w 0
    $w insert end "$text"
    $w configure -state disabled
}

proc setfield {field nval w} {
    global $field
    set ll .control.e.$field.label$field
    set $field $nval
    $ll configure -text "[set $field]:"
    zingtext $w 1
    sayErr "$field: <$nval> selected." zing
}

proc fields-with-props {prop_list} {
    global fid fprops fdescr
    set out ""
    foreach field [array names fprops] {
	set do_it 0
	foreach property [split $prop_list] {
#	    puts stdout $fprops($field)
	    if {[regexp $property $fprops($field)]} {
		set do_it 1
	    }

	    # XX -- this is fairly degenerate
	    if {$field == "password"} {
		set do_it 0
	    }
	}

	if {$do_it} {
	    lappend out "$field"
	}
    }
    lreplace out 0 0
    return $out
}

proc get-fields {} {
    global FD fid fprops fdescr

    puts $FD "fields"
    flush $FD

    set oldfield -11

    set fieldclump [get-info "fields"]
    foreach line [split $fieldclump "\n"] {
	set cline [split $line ":"]
	set fieldid [lindex $cline 1]
	set fieldname [lindex $cline 2]
	set fieldrest [join [lrange $cline 3 end] :]
	if {$fieldid != $oldfield} {
	    set fid($fieldname) $fieldid
	    set fprops($fieldname) $fieldrest
	    set fdescr($fieldname) ""
	} else {
	    append fdescr($fieldname) "$fieldrest\n"
	}
	set oldfield $fieldid
    }
}

proc add_args {} {
    global numfields
    set i 0
    set ret_val ""
    while {$i < $numfields} {
	incr i
	set vname "field$i"
	global stufffield$i $vname
	regsub -all "\"" [set stuff$vname] "" stuff$vname
	set stufffield$i [string trim [set stuff$vname]]
	set sv [set stuff$vname]
	if {$sv != ""} {
	    set fv [set $vname]
	    append ret_val "$fv=\"$sv\" "
	}
    }
    # somehow, that was way too much trouble..
    return $ret_val
}


proc mkinitlogin {w} {
    global FD alias

    zingtext $w 0

    label $w.aliasLabel -width 20 -text "Alias:" \
	-anchor e
    entry $w.alias -textvariable alias -relief sunken -insertwidth 1
    label $w.passwdLabel -width 20 -text "Password:" \
	-anchor e
    entry $w.passwd -textvariable passwd -relief sunken \
	-insertwidth 1 -fg black -bg black

    $w window create end -window $w.aliasLabel
    $w window create end -window $w.alias
    $w insert end "\n"
    $w window create end -window $w.passwdLabel
    $w window create end -window $w.passwd
    $w insert end "\n"

    bind $w.alias <Return> "focus $w.passwd"

    bind $w.passwd <Return> {
	 regsub -all ".passwd" %W "" P
	 set lback 0
	 if {[string trim $alias] != ""} {
	    puts $FD "login $alias\n$passwd"
	    flush $FD
	    set passwd ""
	    while {$lback < 200} {
		set response [gets $FD]
		set response_l [split $response ":"]
		if {[lindex $response_l 0] >= 200 && \
		    [lindex $response_l 0] < 300} {
		    sayErr "Login successful.\n$response" zing
		    zingtext $P 1
		    mklogin [lindex $response_l 0] $P
		} else {
		    focus $P.alias
		}
		set lback [lindex $response_l 0]
	    }
	    set passwd ""
	 }
    }
    bind $w.passwd <1> {}
    bind $w.passwd <Double-1> {}
    bind $w.passwd <Triple-1> {}

    focus $w.alias
    $w configure -state disabled
}

proc mklogin {mode w} {
    global FD fdescr me cur_change_field

    set ct .control.login.l

    catch "destroy $ct"
    frame $ct
    pack $ct

    button $ct.update -relief raised -text "Add/Change Field" \
	-command "mksetfield setcur foo Change $w"
    button $ct.delete -relief raised -text "Delete" \
	-command "mksetfield dfield foo Change $w"
    button $ct.passwd -relief raised -text "Passwd"
    button $ct.logout -relief raised -text "Log out" \
	-command {
	    puts $FD "logout"
	    flush $FD
	    get-info ""
	    catch "destroy .control.login.l"
	}

    pack $ct.logout \
	 $ct.delete \
	 $ct.update \
	 $ct.passwd \
	     -side right -anchor e
    
    # it is unfortunate that this has to be done, but oh well.

    puts $FD "me"
    flush $FD

    set retc 0
    set ofield "XXX"
    set oinfo ""
    set me(foo) ""
    unset me

    while {$retc < 200} {
	set line [split [gets $FD] ":"]
	set retc [lindex $line 0]
	if {$retc == -200} {
	    set nfield [string trim [lindex $line 2]]
	    if {$nfield != ""} {
		catch {set me($ofield) [string trim $me($ofield)]}
		set ofield $nfield
		set oinfo ""
	    }
	    append me($ofield) \
		"[string trim [join [lrange $line 3 end] ":"]]\n"
	}
    }

#    foreach key [array names me] {
#	puts stdout "$key:\n$me($key)"
#    }

}

proc chfield {field val} {
    global FD
    if {$field != ""} {
	catch "unset me($field)"
	puts $FD "make $field=\"$val\""
	flush $FD
	get-info ""
    }
}

proc setcur {foo change_field w} {
    global me
    zingtext $w 0
    text $w.text -width 40 -height 7
    button $w.changeit -text "Update" -relief raised \
	-command "setcurme $change_field $w.text $w"
    button $w.cancel -text "Cancel" -relief raised \
	-command "zingtext $w 1"
    $w window create end -window $w.changeit
    $w window create end -window $w.cancel
    $w insert end "\n"
    $w window create end -window $w.text
    set foo ""
    catch {set foo $me($change_field)}
    $w.text insert end "$foo"
    $w config -state disabled
    focus $w.text
}

proc setcurme {f w wp} {
    global me
    set me($f) [string trimright [$w get 1.0 end]]
    set new_stuff me($f)
    regsub -all "\n" $me($f) "\\n" new_stuff
    regsub -all "\"" $new_stuff "\\\"" new_stuff
    chfield $f "$new_stuff"
    zingtext $wp 1
}

proc dfield {foo del_field w} {
    global me FD
    zingtext $w 1
    if {$del_field != ""} {
	chfield $del_field ""
	catch "unset me($del_field)"
    }
}

proc chpasswd {} {
    entry .passwd.passwd -textvariable passwd -relief sunken \
	-insertwidth 1 -fg white -bg white
    label .passwd.passwdLabel -text "New Password:"

    entry .passwd.cpasswd -textvariable cpasswd -relief sunken \
	-insertwidth 1 -fg white -bg white
    label .passwd.cpasswdLabel -text "Type it again:"

    pack .passwd.passwdLabel .passwd.passwd \
    	 .passwd.cpasswdLabel .passwd.cpasswd \
	    -pady 3 -padx 6 -anchor sw

    bind .passwd.passwd <Return> {
	focus .passwd.cpasswd
    }

    bind .passwd.cpasswd <Return> {
	if {[string trim $passwd] != "" && $passwd == $cpasswd} {
	    puts $FD "passwd\n$passwd"
	    flush $FD
	    get-info ""
	    set passwd ""
	    set cpasswd ""
	    destroy .passwd
	} else {
	    set passwd ""
	    set cpasswd ""
	}
    }

    bind .passwd.passwd <1> {}
    bind .passwd.passwd <Double-1> {}
    bind .passwd.passwd <Triple-1> {}
    bind .passwd.passwd <Control-c> { destroy .passwd }

    focus .passwd.passwd
} 

proc mkserver {w} {
    global phserver
    zingtext $w 0

    entry $w.servername -textvariable phserver -relief sunken -insertwidth 1
    label $w.serverLabel -text "Server name:"

    $w window create end -window $w.serverLabel
    $w window create end -window $w.servername
    focus $w.servername

    bind $w.servername <Return> {
	 global phserver
	 swapserver $phserver
    }

    $w configure -state disabled
}

proc swapserver {server} {
    global FD phserver max outgoing ph phopts

    set w .output.queryOutput
    catch {close $FD}
    set phserver $server
    wm title . "tkph: $phserver"
    set FD [open "|$ph -$phopts -s $phserver" w+]
    set crap [get-info ""]

    # get fields 'n stuff
    get-fields
    set outgoing ""

    zingtext $w 0
    $w insert 1.0 $crap
    $w configure -state disabled
    focus .control.e.q.uery
}

swapserver "$phserver"

