proc dputs {text} {
    global env tcl_platform
    if {$tcl_platform(platform) == "unix"} {
        if {[info exists env(USER)]} {
            if {$env(USER) == "rickm"} {
                #puts $text
            }
        }
    }
}

proc TkGnats_config_platform {} {
    global TkGnats tcl_platform
    if {$tcl_platform(platform) != "unix"} {
        set TkGnats(GNATS_ACCESS) network
        set TkGnats(GNATS_ACCESS_METHOD) socket
        set TkGnats(MailMethod) smtp
        set TkGnats(UserSubdir) tkgnats
    } {
        set TkGnats(UserSubdir) .tkgnats
    }
}

proc TkGnats_config {} {
    global TkGnats
    
    TkGnats_config_platform

    # This file is optional
    if {[info exists TkGnats(ServerInfo)]} {
        if {[llength $TkGnats(ServerInfo)] != 6} {
            wm withdraw .
            Msg "Invalid ServerInfo: $TkGnats(ServerInfo)\n\nPlease completely exit TkGnats and start again. If it still fails, contact your TkGnats administrator."
            exit 1
        }
        if {[lindex $TkGnats(ServerInfo) 1] != {}} {
            set  TkGnats(GNATS_SERVER)  [lindex $TkGnats(ServerInfo) 1]
        }
        if {[lindex $TkGnats(ServerInfo) 2] != {}} {
            set  TkGnats(GNATS_PORT)    [lindex $TkGnats(ServerInfo) 2]
        }
        if {[lindex $TkGnats(ServerInfo) 3] != {}} {
            set  TkGnats(GNATS_ADDR)    [lindex $TkGnats(ServerInfo) 3]
        }
        if {[lindex $TkGnats(ServerInfo) 4] != {}} {
            set  TkGnats(GNATS_DB)      [lindex $TkGnats(ServerInfo) 4]
        }
        if {[lindex $TkGnats(ServerInfo) 5] != {}} {
            set  TkGnats(GNATS_DBALIAS) [lindex $TkGnats(ServerInfo) 5]
        }
    }

    foreach l [array names TkGnats] {
        set tmpvars($l) $TkGnats($l)
    }

    TkGnats_config_rc tmpvars

    foreach l [array names tmpvars] {
        if {![info exists TkGnats($l)]} {
            set TkGnats($l) $tmpvars($l)
        }
    }

    if {[info tclversion] < 8.0} {
        foreach F {DialogFont TextFont HelpFont} {
            set f [string tolower $F]
            set TkGnats($f) $TkGnats($F)
        }
    } {
        foreach F {DialogFont TextFont HelpFont} {
            set f [string tolower $F]
            set TkGnats($f) $f
            eval font create $f [font actual $TkGnats($F)]
        }
    }
    option add *font $TkGnats(dialogfont) 100

    set TkGnats(WISHPATH) [info nameofexecutable]

    # Automatic check for TkGnats updates
    TkGnats_UpdateCheck
}

proc TkGnats_exec {args} {
    global TkGnats
    if {[TkGnats_UpdateCheck]} {
	return
    }
    eval exec $args
}

proc TkGnats_UpdateCheck {} {
    global TkGnats
    if {$TkGnats(AutoUpdateCheck)} {
	if {![info exists TkGnats(UpdateCheckTime)]} {
	    set TkGnats(UpdateCheckTime) [file mtime $TkGnats(lib)/VERSION]
	} {
	    if {$TkGnats(UpdateCheckTime) != [file mtime $TkGnats(lib)/VERSION]} {
		TkGnats_UpdateRequired
		return 1
	    }
	}
    }
    return 0
}

proc TkGnats_UpdateRequired {} {
    global TkGnats
    Msg "TkGnats has detected that some of its components have been recently updated.\n\nContinuing now may cause TkGnats to fail.\n\nPlease quit all TkGnats windows and restart TkGnats as soon as possible."
}

proc TkGnats_config_rc {tmparr} {
    global env tcl_platform
    upvar $tmparr TkGnats

    # We need to protect a previously set GNATS_ADDR from the value in tkgnats.config
    catch {set tempaddr $TkGnats(GNATS_ADDR)}
    catch {source $TkGnats(lib)/tkgnats.config}
    catch {set TkGnats(GNATS_ADDR) $tempaddr}

    ### This section tries to determine the users login, home directory, ###
    ### group and email address. If it fails for you, please let me know ###
    ### what you had to do to fix it.                                    ###

    # TkGnats(LogName)
    # The login name for the user.
    #   - first check the first output field of the id command
    #   - then check USER env var
    #   - then try LOGNAME
    #   - then try running whoami
    #
    # TkGnats(GroupName)
    # The group name for the user.
    #   - first check the output of the groups command for a list of groups
    #   - then check the second output field of the id command for a primary group
    #   - then check GROUP env var

    set user   ""
    set group  ""
    set x      ""
    set y      ""

    if {$tcl_platform(platform) == "unix"} {
	if {![catch {exec groups} result]} {
	    set group $result
	}
	
	if {![catch {exec id} result]} {
	    regexp \\(\[a-zA-Z0-9\]+\\) [lindex [split $result " "] 0] x
	    regexp \\(\[a-zA-Z0-9\]+\\) [lindex [split $result " "] 1] y
	    set user  [string trim $x "()"]
	    if {$group == ""} {
		set group [string trim $y "()"]
	    }
	}
    }

    if {![info exists TkGnats(LogName)]} {
        if {"$user" != ""} {
            set TkGnats(LogName) $user
        } {
            if {[info exists env(USER)] && $env(USER) != "nouser"} {
                set TkGnats(LogName) $env(USER)
            } {
                if {[info exists env(LOGNAME)]} {
                    set TkGnats(LogName) $env(LOGNAME)
                } {
                    if {$tcl_platform(platform) == "unix" && ![catch {exec whoami} x]} {
                        set TkGnats(LogName) $x
                    }
                }
            }
        }
    }

    if {![info exists TkGnats(LogName)]} {
        wm withdraw .
        Msg "No user name found!\nPlease set USER or LOGNAME in environment."
        exit 1
    }

    set TkGnats(FullName) [fullname_from_logname $TkGnats(LogName)]
        
    if {![info exists TkGnats(GroupName)]} {
        if {$group != ""} {
            set TkGnats(GroupName) $group
        } {
            if {[info exists env(GROUP)]} {
                set TkGnats(GroupName) $env(GROUP)
            } {
                set TkGnats(GroupName) ""
            }
        }
    }
         
    if {![info exists TkGnats(EmailAddr)]} {
        if {[info exists env(REPLYTO)]} {
            set TkGnats(EmailAddr) $env(REPLYTO)
        } {
            set TkGnats(EmailAddr) $TkGnats(LogName)
        }
    }

    if {![info exists TkGnats(HOME)]} {
        if {[info exists env(HOME)]} {
            set TkGnats(HOME) $env(HOME)
        }
    }
    
    if {![info exists TkGnats(CategoryList)]} {
        set TkGnats(CategoryList)    ""
    }
    if {![info exists TkGnats(SubmitterList)]} {
        set TkGnats(SubmitterList)   ""
    }
    if {![info exists TkGnats(ResponsibleList)]} {
        set TkGnats(ResponsibleList) ""
    }
    if {![info exists TkGnats(ResponsibleFile)]} {
        set TkGnats(ResponsibleFile) ""
    }
    if {![info exists TkGnats(ClassesList)]} {
        set TkGnats(ClassesList) ""
    }
    if {![info exists TkGnats(ClassesFile)]} {
        set TkGnats(ClassesFile) ""
    }
    if {![info exists TkGnats(StatesList)]} {
        set TkGnats(StatesList) ""
    }
    if {![info exists TkGnats(StatesFile)]} {
        set TkGnats(StatesFile) ""
    }
    
    #
    # Read in any and all tkgnatsrc files
    #
    
    set system $tcl_platform(os)

    if {[file readable $TkGnats(lib)/tkgnatsrc]} {
        source $TkGnats(lib)/tkgnatsrc
    }

    if {[file readable $TkGnats(lib)/tkgnatsrc.$system]} {
        source $TkGnats(lib)/tkgnatsrc.$system
    }

    set TkGnats(tkgnats_version) [file_get_text $TkGnats(lib)/VERSION]
    
    if {![info exists TkGnats(UserDir)]} {
        if {![info exists TkGnats(HOME)]} {
            wm withdraw .
            Msg "No home directory found!\n\nPlease set HOME in environment or TkGnats(UserDir) in the ini file.."
            exit 1
        }
        set TkGnats(UserDir) $TkGnats(HOME)/$TkGnats(UserSubdir)
    }
    set TkGnats(UserDir) [string trimright $TkGnats(UserDir) /]

    check_tkgnats_userdir $TkGnats(UserDir)
    
    if {[file readable $TkGnats(UserDir)/tkgnatsrc]} {
        source $TkGnats(UserDir)/tkgnatsrc
    }
    if {[file readable $TkGnats(UserDir)/tkgnatsrc.$system]} {
        source $TkGnats(UserDir)/tkgnatsrc.$system
    }

    #
    # Get environment variable overrides
    #
    
    if {[info exists env(GNATS_ROOT)]} {
        set config [file_get_text $env(GNATS_ROOT)/gnats-adm/config]
        if {"$config" != ""} {
            set TkGnats(GNATS_ADDR) \
                    [string trim [lindex [split [lindex $config [lsearch -regexp $config GNATS_ADDR]] =] 1] \"]
            
            set TkGnats(GNATS_USER) \
                    [string trim [lindex [split [lindex $config [lsearch -regexp $config GNATS_USER]] =] 1] \"]
            
            set TkGnats(SUBMITTER) \
                    [string trim [lindex [split [lindex $config [lsearch -regexp $config SUBMITTER]] =] 1] \"]
            
            set TkGnats(GNATS_ROOT) $env(GNATS_ROOT)
        }
    }

    if {![info exists TkGnats(ORGANIZATION)]} {
        set TkGnats(ORGANIZATION) $TkGnats(SUBMITTER)
        if {[info exists env(ORGANIZATION)]} {
            if {[file readable $env(ORGANIZATION)]} {
                set TkGnats(ORGANIZATION) [file_get_text $env(ORGANIZATION)]
            } {
                set TkGnats(ORGANIZATION) $env(ORGANIZATION)
            }
        } {
            if {[info exists TkGnats(HOME)]} {
                if {[file readable $TkGnats(HOME)/.signature]} {
                    set TkGnats(ORGANIZATION) [file_get_text $TkGnats(HOME)/.signature]
                }
            }
        }
    }

    set TkGnats(HOSTNAME) [info hostname]
    if {[info exists env(HOSTNAME)]} {
        set TkGnats(HOSTNAME) $env(HOSTNAME)
    }
    if {$tcl_platform(platform) == "unix" && $TkGnats(HOSTNAME) == ""} {
        if {[catch {exec /bin/hostname} TkGnats(HOSTNAME)]} {
            if {[catch {exec /usr/bin/hostname} TkGnats(HOSTNAME)]} {
                if {[catch {exec /usr/ucb/hostname} TkGnats(HOSTNAME)]} {
                    if {[catch {exec /usr/bsd/hostname} TkGnats(HOSTNAME)]} {
                        set TkGnats(HOSTNAME) ""
                    }
                }
            }
        }
    }
    
    #
    # Make sure some required variables are set
    #
    
    if {![info exists TkGnats(GNATS_SERVER)]} {
        set TkGnats(GNATS_SERVER) ""
    }
    if {$TkGnats(GNATS_SERVER) == ""} {
        set TkGnats(GNATS_ACCESS)        local
        set TkGnats(GNATS_ACCESS_METHOD) batch
    } {
        set TkGnats(GNATS_ACCESS) network
        if {![info exists TkGnats(GNATS_ACCESS_METHOD)]} {
            set TkGnats(GNATS_ACCESS_METHOD) socket
        }
        if {$TkGnats(GNATS_ACCESS_METHOD) != "batch"} {
            set TkGnats(GNATS_ACCESS_METHOD) socket
        }
    }
    if {![info exists TkGnats(GNATS_PORT)]} {
        set TkGnats(GNATS_PORT) 1529
    }

    if {![info exists TkGnats(QuerySortMethod)]} {
        set TkGnats(QuerySortMethod) internal
    }

    catch {source $TkGnats(UserDir)/fonts}
    
    label   .l
    set TkGnats(TkDialogFont) [.l cget -font]
    destroy .l
    
    if {![info exists TkGnats(DialogFont)]} {
        if {$tcl_platform(platform) == "unix"} {
            set TkGnats(DialogFont) $TkGnats(TkDialogFont)
        } {
            if {[info tclversion] < 8.0} {
                set TkGnats(DialogFont) $TkGnats(TkDialogFont)
            } {
                set TkGnats(DialogFont) {"ms sans serif" 8}
            }
        }
    }
    
    if {![info exists TkGnats(TextFont)]} {
        if {[info tclversion] < 8.0} {
            set font fixed
        } {
            if {[font metrics [list [lindex $TkGnats(DialogFont) 0]] -fixed]} {
                set font $TkGnats(DialogFont)
            } {
                set font fixed
            }
        }
        if {$tcl_platform(platform) == "unix"} {
            set TkGnats(TextFont) $font
        } {
            if {[info tclversion] < 8.0} {
                set TkGnats(TextFont) $font
            } {
                set TkGnats(TextFont) {"courier new" 8}
            }
        }
    }
    
    if {![info exists TkGnats(HelpFont)]} {
        if {$tcl_platform(platform) == "unix"} {
            set TkGnats(HelpFont) $TkGnats(TextFont)
        } {
            if {[info tclversion] < 8.0} {
                set TkGnats(HelpFont) $TkGnats(TextFont)
            } {
                set TkGnats(HelpFont) {"courier new" 10}
            }
        }
    }
    
    #
    # Set up for local or network access
    #

    if {![info exists TkGnats(GNATS_BINDIR)]} {
        set TkGnats(GNATS_BINDIR) ""
    } {
        set TkGnats(GNATS_BINDIR) [string trim $TkGnats(GNATS_BINDIR)]
    }
    if {$TkGnats(GNATS_BINDIR) != ""} {
        set bindir $TkGnats(GNATS_BINDIR)/
    } {
        set bindir ""
    }
    if {$TkGnats(GNATS_ACCESS) == "local"} {
        set TkGnats(pr-edit)    $TkGnats(GNATS_LIBEXECDIR)/gnats/pr-edit
        set TkGnats(query-pr)   ${bindir}query-pr
    } {
        set hoststr " -d $TkGnats(GNATS_DBALIAS)"
        if {$TkGnats(GNATS_SERVER) != ""} {
            append hoststr " --host $TkGnats(GNATS_SERVER)"
        }
        if {$TkGnats(GNATS_PORT) != ""} {
            append hoststr " --port $TkGnats(GNATS_PORT)"
        }
        set TkGnats(pr-edit)    $TkGnats(GNATS_LIBEXECDIR)/gnats/npr-edit$hoststr
        set TkGnats(query-pr)   ${bindir}nquery-pr$hoststr
    }
    
    #
    # Now get any SERVER based tkgnatsrc
    #
    
    set TkGnats(SiteServerDir) $TkGnats(lib)
    set TkGnats(UserServerDir) $TkGnats(UserDir)
    
    if {$TkGnats(GNATS_SERVER) != ""} {
        set db [lindex $TkGnats(ServerInfo) 4]
        set TkGnats(SiteServerDir) $TkGnats(SiteServerDir)/$db
        if {[file readable $TkGnats(SiteServerDir)/tkgnatsrc]} {
            source $TkGnats(SiteServerDir)/tkgnatsrc
        }
        if {[file  isdirectory $TkGnats(UserDir)/$TkGnats(GNATS_SERVER)]} {
            catch {file rename $TkGnats(UserDir)/$TkGnats(GNATS_SERVER) $TkGnats(UserDir)/$db}
        }
        set TkGnats(UserServerDir) $TkGnats(UserServerDir)/$db
        check_tkgnats_userdir $TkGnats(UserServerDir)
        if {[file readable $TkGnats(UserServerDir)/tkgnatsrc]} {
            source $TkGnats(UserServerDir)/tkgnatsrc
        }
    }
    
    # This checks for the query and sort subdirectories
    check_tkgnats_usersubdir $TkGnats(UserServerDir)

    #
    # Set up user id and password
    #
    
    if {$TkGnats(GNATS_ACCESS) == "local"} {
        set TkGnats(UseridPassword) ""
    } {
        set userid ""
        if {[info exists TkGnats(ServerPasswords)]} {
            foreach pwd [split $TkGnats(ServerPasswords) \n] {
                if {[lindex $pwd 0] == $TkGnats(GNATS_ADDR)} {
                    set userid [lindex $pwd 1]
                    set passwd [lindex $pwd 2]
                    break
                }
            }
        }
        if {$userid == ""} {
            # Might as well see if there's a default access that's higher than the host access
                set userid "anonymous"
                set passwd "guest"
        }
        if {$TkGnats(GNATS_ACCESS_METHOD) == "socket"} {
            set TkGnats(UseridPassword) "$userid $passwd"
        } {
            set TkGnats(UseridPassword) "--user $userid --passwd $passwd"
        }
    }

    #
    # Set up mail method
    #
    
    if {![info exists TkGnats(SMTP_SERVER)]} {
        set TkGnats(SMTP_SERVER) ""
    }
    if {$TkGnats(SMTP_SERVER) == ""} {
        set TkGnats(MailMethod) mailer
    } {
        set TkGnats(MailMethod) smtp
    }
    if {![info exists TkGnats(SMTP_PORT)]} {
        set TkGnats(SMTP_PORT) 25
    }
        
    #
    # Determine if this user is authorized to edit problem reports
    # This only applies to local disk access to the GNATS database.
    # Network access is controlled (later) by gnatsd.
    #
    
    if {$TkGnats(GNATS_ACCESS) == "local"} {
        set glist {}
        set ulist {}
        if {[info exists TkGnats(edit_authorized_groups)]} {
            set  glist  $TkGnats(edit_authorized_groups)
        }
        if {[info exists TkGnats(edit_authorized_users)]} {
            set  ulist  $TkGnats(edit_authorized_users)
        }
        set TkGnats(edit_authorized) 0
        if {$ulist == {} && $glist == {}} {
            set TkGnats(edit_authorized) 1
        }
        if {[lsearch -exact $ulist $TkGnats(LogName)] > -1} {
            set TkGnats(edit_authorized) 1
        }
        foreach group $glist {
            if {[lsearch -exact $TkGnats(GroupName) $group] > -1} {
                set TkGnats(edit_authorized) 1
            }
        }
    }
    
    #
    # Determine if this user is authorized to delete problem reports
    #
    
    set glist {}
    set ulist {}
    if {[info exists TkGnats(delete_authorized_groups)]} {
        set  glist  $TkGnats(delete_authorized_groups)
    }
    if {[info exists TkGnats(delete_authorized_users)]} {
        set  ulist  $TkGnats(delete_authorized_users)
    }
    set TkGnats(delete_authorized) 0
    if {[lsearch -exact $ulist $TkGnats(LogName)] > -1} {
        set TkGnats(delete_authorized) 1
    }
    foreach group $glist {
        if {[lsearch -exact $TkGnats(GroupName) $group] > -1} {
            set TkGnats(delete_authorized) 1
        }
    }
    # The delete function only works on local GNATS systems.
    if {$TkGnats(GNATS_ACCESS) != "local"} {
        set TkGnats(delete_authorized) 0
    }
}

proc get_gnats_config {} {
    global TkGnats
    #
    # Determine if GNATS is Release Based, and get GNATS lists
    #

    # If TkGnats(GNATS_ACCESS_METHOD) != "socket" then this does nothing
    if {[info exists TkGnats(socket,$TkGnats(GNATS_SERVER),$TkGnats(GNATS_PORT),keepopen)]} {
        set keepopen ""
    } {
        set keepopen 1
    }
    if {[open_socket_gnatsd $keepopen] == "-1"} {
        return -1
    }

    get_gnats_version
    
    if {$TkGnats(GNATS_Version) < 3.108 || $TkGnats(GNATS_Version) == 3.2} {
        wm withdraw .
        Msg "Sorry, you're trying to talk to a GNATS $TkGnats(GNATS_Version) database but this version of TkGnats requires GNATS 3.108 or newer."
        return -1
    }
            
    get_gnats_access

    check_release_based

    if {![info exists TkGnats(QueryMode)]} {
        set TkGnats(QueryMode) sql2
    }

    get_category_list
    get_submitter_list
    get_responsible_list
    get_classes_list
    get_states_list

    # If TkGnats(GNATS_ACCESS_METHOD) != "socket" then this does nothing
    close_socket_gnatsd $keepopen
    return ""
}

proc set_edit_authorized {} {
    global TkGnats
    if {$TkGnats(UserAccess) == "edit" || $TkGnats(UserAccess) == "admin"} {
        set TkGnats(edit_authorized) 1
    } {
        set TkGnats(edit_authorized) 0
    }
}

proc get_gnats_access {} {
    global TkGnats
    get_gnats_access_$TkGnats(GNATS_ACCESS_METHOD)
}

proc get_gnats_access_batch {} {
    global TkGnats
    if {$TkGnats(GNATS_ACCESS) == "network" && ![info exists TkGnats(UserAccess)]} {
        catch {eval exec $TkGnats(query-pr) $TkGnats(UseridPassword) --closed-before=1970-01-01 -D} rep
        set TkGnats(UserAccess) unknown
        foreach l [split $rep \n] {
            if {[string first "received 520" $l] > 0} {
                Msg "GNATSD access error:\n\n$l'"
                Exit 1
            }
            if {[string first "access level set" $l] > 0} {
                set TkGnats(UserAccess) [lindex $l end]
                break
            }
        }
        set_edit_authorized
    }
}

proc get_gnats_access_socket {} {
    global TkGnats
    # The access level is saved when the socket is opened
    if {![info exists TkGnats(UserAccess)]} {
        set TkGnats(UserAccess) unknown
    }
}

proc get_gnats_version {} {
    global TkGnats
    get_gnats_version_$TkGnats(GNATS_ACCESS_METHOD)
}

proc get_gnats_version_batch {} {
    global TkGnats
    if {![info exists TkGnats(GNATS_Version)]} {
        if {[catch {eval exec $TkGnats(query-pr) --version} rep]} {
            set TkGnats(GNATS_Version) 0.0
        } {
            set TkGnats(GNATS_Version) [lindex $rep end]
        }
    }
}

proc get_gnats_version_socket {} {
    global TkGnats
    # The version number is saved when the socket is opened
    if {![info exists TkGnats(GNATS_Version)]} {
        set TkGnats(GNATS_Version) 0.0
    }
}

proc check_tkgnats_userdir {userdir} {
    global TkGnats
    if {$TkGnats(CurrentProgram) == "tkgnats"} {
        return
    }
    if {![file isdirectory $userdir]} {
        file mkdir $userdir
    }
}

proc check_tkgnats_usersubdir {userdir} {
    global TkGnats
    if {$TkGnats(CurrentProgram) == "tkgnats"} {
        return
    }
    if {![file isdirectory $userdir/query]} {
        file mkdir $userdir/query
        catch {eval file copy [glob [file dirname $userdir]/query/*] $userdir/query}
    }
    if {![file isdirectory $userdir/sort]} {
        file mkdir $userdir/sort
        catch {eval file copy [glob [file dirname $userdir]/sort/*]  $userdir/sort}
    }
    if {![file exists $userdir/default-sort]} {
        catch {eval file copy [glob [file dirname $userdir]/default-sort] $userdir}
    }
    if {![file exists $userdir/default-view]} {
        catch {eval file copy [glob [file dirname $userdir]/default-view] $userdir}
    }
}

#
# Procedures
#

proc Msg {args} {
    set msg ""
    set nargs [expr [llength $args] - 1]
    for {set i 0} {$i < $nargs} {incr i} {
        append msg "[lindex $args $i]\n"
    }
    append msg "[lindex $args $nargs]"
    bell
    tk_dialog .tkerr "TkGnats Error" $msg "error" 0 "OK"
}

proc Notice {args} {
    set msg ""
    set nargs [expr [llength $args] - 1]
    for {set i 0} {$i < $nargs} {incr i} {
        append msg "[lindex $args $i]\n"
    }
    append msg "[lindex $args $nargs]"
    tk_dialog .tknotice "TkGnats Notice" $msg "info" 0 "OK"
}

# reap any zombied exec's
set TkGnats(reap_scheduled) 0
proc do_reap {} {
    global TkGnats
    catch {exec true}
    set TkGnats(reap_scheduled) 0
}

proc schedule_reap {} {
    global TkGnats
    if {!$TkGnats(reap_scheduled)} {
        set TkGnats(reap_scheduled) 1
        after 5000 do_reap
    }
}

proc Exit {x} {
    #destroy .; # use if before tk3.3
    exit $x
}

proc get_responsible_addr {name} {
    global TkGnats
    # strip off whitespace and then take out the first word.
    # we assume the rest is a (Full Name) type comment
    set name [string  trim  $name "\t\n "]
    set name [lindex [split $name "\t\n "] 0]
    set addr $name
    foreach n $TkGnats(ResponsibleFile) {
        set res [split $n :]
        if {$name == [lindex $res 0]} {
            if {[lindex $res 2] != ""} {
                set addr [lindex $res 2]
                break
            }
        }
    }
    return $addr
}

#
# trim pr field data whitespace
#
proc ftrim {s} {
    return [string trim $s "\t\n "]
}

proc gnatsd_chdb {s} {
    global TkGnats

    puts $s "CHDB $TkGnats(GNATS_DBALIAS)"
    set rep [get_socket_reply $s]
    if {![string match 2* [lindex $rep 0]]} {
        Msg "GNATSD error setting GNATS database:\n" "[join $rep \n]"
        return -1
    }
    return $s
}

proc open_socket_gnatsd {{keepopen {}}} {
    global TkGnats
    if {$TkGnats(GNATS_ACCESS_METHOD) == "socket"} {
        if {[info exists TkGnats(socket,$TkGnats(GNATS_SERVER),$TkGnats(GNATS_PORT))]} {
            return $TkGnats(socket,$TkGnats(GNATS_SERVER),$TkGnats(GNATS_PORT))
        }
        set s  [open_socket $TkGnats(GNATS_SERVER) $TkGnats(GNATS_PORT) $keepopen]
        if {$s == -1} {
            return -1
        }
        if {[gnatsd_chdb $s] != $s} {
            return -1
        }
        set cmd [subst "USER $TkGnats(UseridPassword)"]
        puts $s $cmd
        set rep [get_socket_reply $s]    
        if {[string match 2* [lindex $rep 0]]} {
            set TkGnats(UserAccess) [lindex [lindex $rep 0] end]
            set_edit_authorized
            return $s
        } {
            # gnatsd closes the connection when this happens
            unset TkGnats(socket,$TkGnats(GNATS_SERVER),$TkGnats(GNATS_PORT))
            catch {unset TkGnats(socket,$TkGnats(GNATS_SERVER),$TkGnats(GNATS_PORT),keepopen)}
            Msg "GNATSD error sending USER command:\n" "[join $rep \n]"
            return -1
        }
    }
    return ""
}

proc close_socket_gnatsd {{force {}}} {
    global TkGnats
    if {$TkGnats(GNATS_ACCESS_METHOD) == "socket"} {
        return [close_socket $TkGnats(GNATS_SERVER) $TkGnats(GNATS_PORT) $force]
    }
    return ""
}

proc open_socket {server port {keepopen {}}} {
    global TkGnats
    if {[info exists TkGnats(socket,$server,$port)]} {
        return $TkGnats(socket,$server,$port)
    }
    if {[catch {set s [socket $server $port]} rep]} {
        Msg "Error-1 opening socket/port $server $port:\n\n$rep"
        return "-1"
    }
    fconfigure $s -buffering line -translation crlf -buffersize 102400

    set rep [get_socket_reply $s]
    #puts "rep=$rep" 
    
    if {![string match 2* [lindex $rep 0]]} {
        Msg "Error-2 opening socket/port $server $port:\n" "[join $rep \n]"
        return "-1"
    }

    set TkGnats(socket,$server,$port) $s
    set rep [lindex $rep 0]
    if {[lsearch $rep GNATS] >= 0} {
        set TkGnats(GNATS_Version) [lindex $rep [expr [llength $rep] - 2]]
    }
    
    if {$keepopen != ""} {
        set TkGnats(socket,$server,$port,keepopen) $keepopen
    }
dputs "opened socket $server $port $keepopen"
    return $s
}

proc close_socket {server port {force {}}} {
    global TkGnats
    if {![info exists TkGnats(socket,$server,$port)]} {
dputs "non-exist return"
        return ""
    }
    #puts "force=$force exists=[info exists TkGnats(socket,$server,$port,keepopen)]"
    if {$force != "" || ![info exists TkGnats(socket,$server,$port,keepopen)]} {
        set    s $TkGnats(socket,$server,$port)
        puts  $s "QUIT"
        set   rep [get_socket_reply $s]
        #puts "rep=$rep"
        close $s
        unset TkGnats(socket,$server,$port)
        catch {unset TkGnats(socket,$server,$port,keepopen)}
dputs "closed socket $server $port $force"
    } {
dputs "non-close return"
    }
    return ""
}

proc get_gnats_list {type} {
    global TkGnats
    return [get_gnats_list_$TkGnats(GNATS_ACCESS_METHOD) $type]
}

proc get_gnats_list_batch {type} {
    global TkGnats
    return [eval exec $TkGnats(query-pr) $TkGnats(UseridPassword) --list-$type]
}

proc get_gnats_list_socket {type} {
    global TkGnats
    if {[set s [open_socket_gnatsd]] == "-1"} {
        return -1
    }
    case $type categories {
        set cmd LCAT
    } submitters {
        set cmd LSUB
    } responsible {
        set cmd LRES
    } classes {
        set cmd LCLA
    } states {
        set cmd LSTA
    }

    puts $s $cmd
    set rep [get_socket_reply $s]
    if {![string match 2* [lindex $rep 0]]} {
        Msg "GNATSD error getting GNATS $type list:\n" "[join $rep \n]"
        return -1
    }

    set glist [join [get_gnatsd_reply_dot_ended $s] \n]
    #puts $glist    
    close_socket $TkGnats(GNATS_SERVER) $TkGnats(GNATS_PORT)
    
    return $glist
}

#
# get a list of valid gnats categories
#
proc get_categories {{pat "*"}} {
    global TkGnats
    set catlist {}
    set clist [get_gnats_list categories]
    foreach c [split $clist "\n"] {
        # ignore lines with leading hash or underscore
        case $c "#*" {
        } "_*" {
        } $pat {
            lappend catlist [lindex [split $c ":"] 0]
        }
    }
    if {$catlist == ""} {
        Msg "Cannot get GNATS categories"
        return ""
    }
    return [lsort $catlist]
}

#
# get a list of valid gnats submitters
#
proc get_submitters {{pat "*"}} {
    global TkGnats
    set sublist {}
    set slist [get_gnats_list submitters]
    foreach s [split $slist "\n"] {
        # ignore lines with leading hash or underscore
        case $s "#*" {
        } "_*" {
        } $pat {
            lappend sublist [lindex [split $s ":"] 0]
        }
    }
    if {$sublist == ""} {
        Msg "Cannot get GNATS submitters"
        return ""
    }
    return [lsort $sublist]
}

#
# get a list of valid gnats responsibles
#
proc get_responsibles {{pat "*"}} {
    global TkGnats
    set reslist {}
    set TkGnats(ResponsibleFile) {}
    set rlist [get_gnats_list responsible]
    foreach r [split $rlist "\n"] {
        # ignore lines with leading hash or underscore
        case $r "#*" {
        } "_*" {
        } $pat {
            lappend reslist [lindex [split $r ":"] 0]
            lappend TkGnats(ResponsibleFile) $r
        }
    }
    if {$reslist == ""} {
        Msg "Cannot get GNATS responsibles"
        return ""
    }
    return [lsort $reslist]
}

#
# get a list of valid gnats classes
#
proc get_classes {} {
    global TkGnats
    set reslist {}
    set TkGnats(ClassesFile) {}
    set rlist [get_gnats_list classes]
    foreach r [split $rlist "\n"] {
        lappend classeslist [lindex [split $r ":"] 0]
        lappend TkGnats(ClassesFile) $r
    }
    if {$classeslist == ""} {
        Msg "Cannot get GNATS classes"
        return ""
    }
    return $classeslist
}

#
# get a list of valid gnats states
#
proc get_states {} {
    global TkGnats
    set reslist {}
    set TkGnats(StatesFile) {}
    set rlist [get_gnats_list states]
    foreach r [split $rlist "\n"] {
        lappend stateslist [lindex [split $r ":"] 0]
        lappend TkGnats(StatesFile) $r
    }
    if {$stateslist == ""} {
        Msg "Cannot get GNATS states"
        return ""
    }
    return $stateslist
}

proc get_classes_list {} {
    global TkGnats
    if {$TkGnats(ClassesList) == ""} {
        if {$TkGnats(ClassesFile) == ""} {
            set  TkGnats(ClassesList) [get_classes] 
            if {$TkGnats(ClassesList) == ""} {
                Msg "The classes list is empty!"
                Exit 1
            }
        } {
            set clist ""
            foreach c $TkGnats(ClassesFile) {
                lappend clist [lindex [split $c ":"] 0]
            }
            set TkGnats(ClassesList) $clist
        }
    }
}

proc get_states_list {} {
    global TkGnats
    if {$TkGnats(StatesList) == ""} {
        if {$TkGnats(StatesFile) == ""} {
            set  TkGnats(StatesList) [get_states] 
            if {$TkGnats(StatesList) == ""} {
                Msg "The states list is empty!"
                Exit 1
            }
        } {
            set slist ""
            foreach s $TkGnats(StatesFile) {
                lappend slist [lindex [split $s ":"] 0]
            }
            set TkGnats(StatesList) $slist
        }
    }
}

proc get_category_list {} {
    global TkGnats
    if {$TkGnats(CategoryList) == ""} {
        set  TkGnats(CategoryList) [get_categories] 
        if {$TkGnats(CategoryList) == ""} {
            Msg "The categories list is empty!"
            Exit 1
        }
    }
}

proc get_submitter_list {} {
    global TkGnats
    if {$TkGnats(SubmitterList) == ""} {
        set  TkGnats(SubmitterList) [get_submitters] 
        if {$TkGnats(SubmitterList) == ""} {
            Msg "The submitters list is empty!"
            Exit 1
        }
    }
}

proc get_responsible_list {} {
    global TkGnats
    if {$TkGnats(ResponsibleList) == ""} {
        if {$TkGnats(ResponsibleFile) == ""} {
            set  TkGnats(ResponsibleList) [get_responsibles] 
            if {$TkGnats(ResponsibleList) == ""} {
                Msg "The responsibles list is empty!"
                Exit 1
            }
        } {
            set reslist ""
            foreach r $TkGnats(ResponsibleFile) {
                lappend reslist [lindex [split $r ":"] 0]
            }
            set TkGnats(ResponsibleList) [lsort $reslist]
        }
    }
}

#
# get the users name from the passwd file given their logname
# try NIS first, then try the regular passwd file
#
proc fullname_from_logname {{lname ""}} {
    global TkGnats
    if {"$lname" == ""} {
        set lname $TkGnats(LogName)
    }
    set fullname ""
    # first try NIS, then try the regular passwd file...
    if {[catch {set fullname [exec ypcat passwd | grep ^${lname}: | cut -f5 -d:]}]} {
        set fullname [lindex [split [file_search_string /etc/passwd ^${lname}:] :] 4]
    }
    return [lindex [split $fullname ,] 0]
}

proc radiobar_frame {parent frname} {
    frame $frname
    frame $frname.labels
    frame $frname.values
    frame $frname.bars
    pack  $frname.labels -side left -anchor w -padx 2 -pady 0 -fill y -expand 1
    pack  $frname.values -side left -anchor w -padx 0 -pady 0 -fill y -expand 1
    pack  $frname.bars   -side left -anchor w -padx 0 -pady 0 -fill y -expand 1
    pack  $frname -anchor w -pady 0
}

# text field related procs

proc textset {l t {p ""} {e text}} {
    # a label
    if {[winfo exists ${p}._${l}.textlabel]} {
        ${p}._${l}.textlabel configure -text $t
        return
    }
    # text widget
    if {[winfo exists ${p}._${l}_fr.text]} {
        ${p}._${l}_fr.text delete 1.0 end
        ${p}._${l}_fr.text insert 1.0 $t
        return
    }
    # entry widget (text and date)
    if {[winfo exists ${p}._${l}.$e]} { 
        ${p}._${l}.$e delete 0 end
        ${p}._${l}.$e insert 0 $t
        return
    }
    error "no such window for $l"
}

proc textget {l {p ""} {e text}} {
    if {[catch  {set x [lindex [${p}._${l}.textlabel configure -text] 4]}  ]} {
        if {[catch {set x [${p}._${l}_fr.text get 1.0 end]}]} {
            return [string trim [${p}._${l}.$e get] "\n"]
        }
    }
    return "\n$x"
}

proc readonly_singletext {l {t ""} {labwid 12} {valwid 0}} {
    global TkGnats
    if {$valwid == 0} {
        set valwid [string length "$t"]
    }
    set f  [frame ._${l}]
    set lw [button $f.label    -anchor w -width $labwid -text "$l: " -command "helpMsg $l" \
            -relief flat -padx 0 -pady 0 -borderwidth 0 -highlightthickness 0]
    set ew [label $f.textlabel -anchor w -width $valwid -text "$t" -relief groove \
            -highlightthickness 0 -borderwidth 2 -background $TkGnats(ReadOnlyBackground) -padx 2 -pady 0]
    pack $lw -side left -anchor w -pady 0 -padx 2 -ipady 0
    pack $ew -side left -anchor w -pady 0 -ipady 0
    pack $f  -side top  -anchor w -pady 0 -fill x -ipady 0
    return $ew
}

bind Entry <KeyPress-Return> " "

proc get_datesel {w title} {
    global TkGnats
    set date [datesel [$w get] $title $TkGnats(textfont)]
    if {$date != ""} {
        $w delete 0 end
        $w insert 0 $date
    }
}

proc daterange {parent l w {t1 ""} {t2 ""} {labwid 12}} {
    global TkGnats
    set f [frame $parent._${l}]
    # trim off any leading >'s for the label text
    set lw [button $f.label -anchor w -width $labwid -text "[string trimleft $l >]: " \
            -command "helpMsg [string trimleft $l >]" -relief flat -padx 0 -pady 0 -borderwidth 0]
    pack $lw -side left -anchor w
    set lw1 [button $f.label1 -anchor center -width 4 -text from \
            -command "get_datesel $f.after \"$l - from\"" \
            -relief raised -padx 0 -pady 0 -borderwidth 1]
    set ew1 [entry $f.after  -width 11 \
        -insertwidth 1  -insertofftime 400 -highlightthickness 2 \
        -relief sunken -borderwidth 2 -background $TkGnats(EditFieldBackground)]
    set_focus_style $ew1
    $ew1 insert end $t1
    pack $lw1 -side left -anchor w
    pack $ew1 -side left -anchor w -fill none -expand 0
    set lw2 [button $f.label2 -anchor c -width 2 -text to \
            -command "get_datesel $f.before \"$l - to\"" \
            -relief raised -padx 0 -pady 0 -borderwidth 1]
    set ew2 [entry $f.before -width 11 \
        -insertwidth 1  -insertofftime 400 -highlightthickness 2 \
        -relief sunken -borderwidth 2 -background $TkGnats(EditFieldBackground)]
    set_focus_style $ew2
    $ew2 insert end $t2
    pack $lw2 -side left -anchor w
    pack $ew2 -side left -anchor w -fill none -expand 0
    pack $f   -side top  -anchor w -fill x -pady 2
    return "$ew1 $ew2"
}

proc singletext {parent l w {t ""} {labwid 12}} {
    global TkGnats
    set f [frame $parent._${l}]
    # trim off any leading >'s for the label text
    set lw [button $f.label -anchor w -width $labwid -text "[string trimleft $l >]: " \
            -command "helpMsg [string trimleft $l >]" -relief flat -padx 0 -pady 0 -borderwidth 0]
    set ew [entry $f.text -width $w \
        -insertwidth 1 -insertofftime 400 -highlightthickness 2 \
        -relief sunken -borderwidth 2 -background $TkGnats(EditFieldBackground)]
    set_focus_style $ew
    $ew insert end $t
    pack $lw -side left -anchor w
    pack $ew -side left -anchor w -fill x -expand true
    if {[string first "Date-Required" $l] >= 0} {
        set cw [button $f.cal -anchor c -width 13 -text "Calendar..." \
            -command "get_datesel $f.text $l" \
            -relief raised -padx 0 -pady 0 -borderwidth 2]
        pack $cw -side left -anchor w -padx 1
    }
    pack $f  -side top  -anchor w -fill x -pady 2
    return $ew
}

proc bagged_singletext {l w bagname {prefix ""} {t ""}} {
    global TkGnats
    upvar #0 $bagname bag
    set f [frame ._${l}]
    set lw [label $f.label -anchor w -text "$l: "]
    set ew [entry $f.text -width 80 \
        -insertwidth 1  -insertofftime 400  \
        -relief sunken -borderwidth 2 -background $TkGnats(EditFieldBackground)]
    set_focus_style $ew
    $ew insert end $t
    pack $lw -side left  -anchor w -fill x -expand true
    pack $ew -side right -anchor e
    pack $f  -side top   -anchor w -fill x -pady 2
    set bag($prefix$l) [format {[string trim [%s get]]} $lw]
    return $ew
}

proc multitext {lbl h} {
    global TkGnats
    set l _$lbl
    set f [frame .${l}_fr]
    button $f.label -anchor w -text "[string trimleft $lbl >]: " \
            -command "helpMsg [string trimleft $lbl >]" \
            -relief flat -padx 0 -pady 0 -borderwidth 0
    text $f.text \
        -wrap $TkGnats(TextWrap) \
        -yscrollcommand "$f.sb set" \
        -height $h -width 80 -relief sunken -padx 4 -insertwidth 1 \
        -insertofftime 400 -borderwidth 2 -background $TkGnats(EditFieldBackground)
    set_focus_style $f.text
    scrollbar $f.sb -command "$f.text yview" -relief sunken
    pack $f.label -side top   -anchor w
    pack $f.sb    -side left  -fill y
    pack $f.text  -side right -fill both -expand true
    pack $f       -side top   -fill both -expand true -padx 16 -pady 2

    return $f.text
}
proc set_focus_style {w} {
    global TkGnats
    if {$TkGnats(FocusStyle) == "mouse"} {
        bind $w <Enter> "+focus $w"
    }
}

proc set_text_traversal {tlist} {
    set ll [llength $tlist]
    if {$ll < 2} {
        return
    }
    for {set x 1} {$x<$ll} {incr x} {
        set w [lindex $tlist $x]
        set prevw [lindex $tlist [expr $x-1]]
        bind $prevw <Tab>       "focus $w
        break"
        bind $prevw <Control-n> "focus $w"
    }
    bind [lindex $tlist [expr $ll-1]] <Tab>       "focus [lindex $tlist 0]
    break"
    bind [lindex $tlist [expr $ll-1]] <Control-n> "focus [lindex $tlist 0]"
    
    bind [lindex $tlist 0] <Shift-Tab> "focus [lindex $tlist [expr $ll-1]]
        break"
    bind [lindex $tlist 0] <Control-p> "focus [lindex $tlist [expr $ll-1]]"
    for {set x 0} {$x < [expr $ll-1]} {incr x} {
        set w [lindex $tlist $x]
        set nextw [lindex $tlist [expr $x+1]]
        bind $nextw <Shift-Tab> "focus $w
        break"
        bind $nextw <Control-p> "focus $w"
    }
}

proc bagged_radiobar {fr n labeltext blist offLabel dstbag {valwid 0}} {
    radiobar $fr $n $labeltext $blist $offLabel > $dstbag $valwid
}

# make one in a list a radiobutton bar
proc radiobar {fr n labeltext blist offLabel {varprefix ""} {aname ""} {valwid 0}} {
    global TkGnats flds tcl_platform
    if {$tcl_platform(platform) == "unix"} {
        set buttonbd 2
    } {
        set buttonbd 0
    }
    if {"$aname" != ""} {
        set vname [set aname]($varprefix$labeltext)
    } {
        set vname $varprefix$labeltext
    }
    global $vname
    
    set $vname ""
    button $fr.labels.$n -text "${labeltext}: " -command "helpMsg $labeltext" \
            -relief flat -padx 0 -pady 0 -borderwidth 0 -width 14 -anchor w \
            -highlightthickness 0 -borderwidth 0
    pack   $fr.labels.$n -side top -anchor w -padx 0 -pady 0 -fill none -expand 1 -ipady 0
    
    if {$valwid != 0} {
        label $fr.values.$n -text "[string trim $flds($varprefix$labeltext) " \n\t"]" \
                -relief groove -anchor w -width $valwid -background $TkGnats(ReadOnlyBackground) \
                -padx 2 -pady 0 -highlightthickness 0 -borderwidth 2
        pack  $fr.values.$n -side top -anchor w -padx 0 -pady 0 -fill none -expand 1 -ipady 0
    }

    frame $fr.bars.$n
    foreach b $blist {
        radiobutton $fr.bars.$n._$b \
                -text $b -relief flat -variable $vname -pady 0 \
                -highlightthickness 0 -borderwidth $buttonbd
        # Buttons that say None should set variable to the empty
        # string...
        if {"$b" == "$offLabel"} {
            $fr.bars.$n._$b configure -value ""
        } {
            $fr.bars.$n._$b configure -value $b
        }
        pack $fr.bars.$n._$b -side left -anchor w -padx 8 -pady 0 -fill none -expand 0 -ipady 0
    }
    pack $fr.bars.$n -side top -anchor w -expand true -fill x -padx 0 -pady 0
}

proc radiobar_set {fr n b} {
    $fr.bars.$n._$b invoke
}

# make one in a list a radiobutton bar
proc checkbar {fr n labeltext blist offLabel} {
    global tcl_platform
    if {$tcl_platform(platform) == "unix"} {
        set buttonbd 2
    } {
        set buttonbd 0
    }
    upvar #0 gbag ${labeltext}
    
    button $fr.labels.$n -text "${labeltext}: " -command "helpMsg $labeltext" \
            -relief flat -width 14 -padx 0 -pady 0 -borderwidth 0 -anchor w -highlightthickness 0
    pack   $fr.labels.$n -side top -anchor w -padx 0 -pady 0 -fill none -expand 1 -ipady 0
    frame  $fr.bars.$n
    foreach b $blist {
        checkbutton $fr.bars.$n._$b \
                -offvalue "" \
                -text $b -relief flat -highlightthickness 0 -borderwidth $buttonbd \
                -variable [format "%s(%s)" ${labeltext} ${b}] -pady 0
        # Buttons that say None should set variable to the empty
        # string...
        if {"$b" == "$offLabel"} {
            $fr.bars.$n._$b configure -onvalue "_ALL_" -offvalue ""
        } {
            $fr.bars.$n._$b configure -onvalue $b -offvalue ""
        }
        set gbag($b) ""
        pack $fr.bars.$n._$b -side left -anchor w -padx 8 -pady 0 -fill none -expand 0 -ipady 0
    }
    # set active [lindex $blist 0]
    # $fr.bars.$n.$active select
    pack $fr.bars.$n -side top -anchor w -expand true -fill x -padx 0 -pady 0
}

#
# convert some numeric fields in a 'query-pr --sql2'
# record named 'f' in the caller to mnemonic strings
#
proc convertsqlflds {f} {
    upvar 1 $f flds
    foreach a [array names flds] {
        set n $flds($a)
        case $a Severity {
            case $n 1 { } 2 { } 3 { }
        } Priority {
            case $n 1 { } 2 { } 3 { }
        }
    }
}

#
# split a pr stream into a tcl array named v
#
# A special array index called _prefix_ contains  all the text prior to
# to the first gnats field
#
proc parsepr_txt {txt varname} {
    upvar 1 $varname fields
    set gnats_tag_exp {^(>[^:]+):(.*)}
    set mail_tag_exp {^([A-Z][^:]+):[   ]+(.*)}
    set no_gnats_tags_yet 1
    set fields(_prefix_) ""
    set fldtags {_prefix_}

    set leftoverln ""
    set prtxt [split $txt "\n"]
    set prlen [llength $prtxt]
    set pridx 0
    while {1} {

        if {"$leftoverln" == ""} {
            if {$pridx >= $prlen} {
                break
            }
            set ln [lindex $prtxt $pridx]
            incr pridx
        } {
            set ln $leftoverln
            set leftoverln ""
        }

        set tag ""
        set val ""

        regexp $gnats_tag_exp $ln matched tag val
        if {"$tag" != ""} {
            set no_gnats_tags_yet 0
            # a gnats tag
            # gnats tags can bu multiline so now
            # get all the lines 'till the next gnats tag
            lappend fldtags $tag
            set fields($tag) "$val\n"
            while {$pridx < $prlen} {
                set ln [lindex $prtxt $pridx]
                incr pridx
                set tag2 ""
                regexp $gnats_tag_exp $ln matched tag2 val
                if {"$tag2" != ""} {
                    #  a new gnats tag so we have hit the end of the 
                    # current one.. leave the line we just read in
                    # leftoverln and continue on in the loop
                    set leftoverln $ln
                    break;
                }
                append fields($tag) "$ln\n"
            }
            continue
        }
        if {$no_gnats_tags_yet} {
            append fields(_prefix_) "$ln\n"
        }

        # If we get here the current line is not part of a gnats tag
        # value pair
        set tag ""
        set val ""
        # Here is where we split out regular mail headers if needed.
        regexp $mail_tag_exp $ln matched tag val
        if {"$tag" != ""} {
            lappend fldtags $tag
            set fields($tag) "$val\n"
        }
    }

    #
    # Do a little post processing before on the fields we leave
    #
    # For the Reply-To: field make sure the (descriptive name) part of
    #   logname (descriptive name)
    # for the email address is stripped out
    #
    if {![info exists fields(Reply-To)]} {
        lappend fldtags Reply-To
        if {[info exists fields(Sender)]} {
            set fields(Reply-To) $fields(Sender)
        } {
            if {[info exists fields(From)]} {
                set fields(Reply-To) $fields(From)
            } {
                set fields(Reply-To) "_unknown_"
            }
        }
    }
    set fields(Reply-To) [string trim $fields(Reply-To) " \n\t"]

    # If Last-Modified is missing (old GNATS v3.2 problem reports),
    # set it to the file's "mtime".
    # It's never missing, actually, because query-pr adds it if it is.
    # Also, maybe it's not a good idea to load the mtime, since new pr's
    # start out with a blank Last-Modified. We don't want to fill it in.
    
#    if {![info exists fields(>Last-Modified)]} {
#        lappend fldtags >Last-Modified
#        set fields(>Last-Modified) "\n"
#    }
#    if {[string trim $fields(>Last-Modified)] == ""} {
#        global TkGnats
#        set filename $TkGnats(GNATS_ROOT)/[string trim $fields(>Category)]/[string trim $fields(>Number)]
#        set fields(>Last-Modified) "  [clock format [file mtime $filename]]\n"
#    }

    return $fldtags
}

proc parsepr {fin varname} {
    upvar 1 $varname fields
    set gnats_tag_exp {^(>[^:]+):(.*)}
    set mail_tag_exp {^([A-Z][^:]+):[   ]+(.*)}
    set no_gnats_tags_yet 1
    set fields(_prefix_) ""
    set fldtags {_prefix_}

    set leftoverln ""
    while {1} {

        if {"$leftoverln" == ""} {
            set x [gets $fin ln]
            if {$x < 0} {
                break
            }
        } {
            set ln $leftoverln
            set leftoverln ""
        }

        set tag ""
        set val ""

        regexp $gnats_tag_exp $ln matched tag val
        if {"$tag" != ""} {
            set no_gnats_tags_yet 0
            # a gnats tag
            # gnats tags can bu multiline so now
            # get all the lines 'till the next gnats tag
            lappend fldtags $tag
            set fields($tag) "$val\n"
            while {[gets $fin ln]>=0} {
                set tag2 ""
                regexp $gnats_tag_exp $ln matched tag2 val
                if {"$tag2" != ""} {
                    #  a new gnats tag so we have hit the end of the 
                    # current one.. leave the line we just read in
                    # leftoverln and continue on in the loop
                    set leftoverln $ln
                    break;
                }
                append fields($tag) "$ln\n"
            }
            continue
        }
        if {$no_gnats_tags_yet} {
            append fields(_prefix_) "$ln\n"
        }

        # If we get here the current line is not part of a gnats tag
        # value pair
        set tag ""
        set val ""
        # Here is where we split out regular mail headers if needed.
        regexp $mail_tag_exp $ln matched tag val
        if {"$tag" != ""} {
            lappend fldtags $tag
            set fields($tag) "$val\n"
        }
    }

    #
    # Do a little post processing before on the fields we leave
    #
    # For the Reply-To: field make sure the (descriptive name) part of
    #   logname (descriptive name)
    # for the email address is stripped out
    #
    if {![info exists fields(Reply-To)]} {
        lappend fldtags Reply-To
        if {[info exists fields(Sender)]} {
            set fields(Reply-To) $fields(Sender)
        } {
            if {[info exists fields(From)]} {
                set fields(Reply-To) $fields(From)
            } {
                set fields(Reply-To) "_unknown_"
            }
        }
    }
    set fields(Reply-To) [string trim $fields(Reply-To) " \n\t"]

    # If Last-Modified is missing (old GNATS v3.2 problem reports),
    # set it to the file's "mtime".
    # It's never missing, actually, because query-pr adds it if it is.
    # Also, maybe it's not a good idea to load the mtime, since new pr's
    # start out with a blank Last-Modified. We don't want to fill it in.
    
#    if {![info exists fields(>Last-Modified)]} {
#        lappend fldtags >Last-Modified
#        set fields(>Last-Modified) "\n"
#    }
#    if {[string trim $fields(>Last-Modified)] == ""} {
#        global TkGnats
#        set filename $TkGnats(GNATS_ROOT)/[string trim $fields(>Category)]/[string trim $fields(>Number)]
#        set fields(>Last-Modified) "  [clock format [file mtime $filename]]\n"
#    }

    return $fldtags
}

proc write_listbox {lbname fname} {
    set fout [open $fname w]
    set sz [$lbname size]
    for {set x 0} {$x < $sz} {incr x 1} {
        puts $fout [$lbname get $x]
    }
    close $fout
}

proc write_listbox_selection {lbname fname} {
    set    fout [open $fname w]
    puts  $fout [$lbname get [$lbname curselection]]
    close $fout
}

proc foreach_listbox {lbname procname} {
    set sz [$lbname size]
    for {set x 0} {$x < $sz} {incr x 1} {
        if {[$procname [$lbname get $x]] != 0} {
            return
        }
    }
}

proc get_max_strlen { l } {
    set maxlen 0
    foreach e $l {
        if {[string length $e] > $maxlen} {
            set maxlen [string length $e]
        }
    }
    return $maxlen
}

proc build_sort_cmd {fieldnames fieldflgs sortfields} {
    global TkGnats
    return [build_sort_cmd_$TkGnats(QuerySortMethod) $fieldnames $fieldflgs $sortfields]
}

proc build_sort_cmd_external {fieldnames fieldflgs sortfields} {
    set rval "-fb -t|"
    foreach fname $sortfields {
        set idx  [lsearch $fieldnames $fname]
        set flgs [lindex  $fieldflgs  $idx]
        append rval [format " +%d%s -%d" $idx $flgs [expr $idx+1]]
    }
    return "$rval"
}

proc build_sort_cmd_internal {fieldnames fieldflgs sortfields} {
    set rval ""
    foreach fname $sortfields {
        append rval " [lsearch $fieldnames $fname]"
    }
    return "$rval"
}

proc sort_listbox {lb} {
    set vals [lsort [$lb get 0 end]]
    $lb delete 0 end
    eval $lb insert end $vals
}

proc make_txt_mb {multitextflds} {
    global TkGnats
    set   f [frame .multiline -relief groove  -borderwidth 2]
    
    frame  .mb
    button .mb.lab -text "Text Fields =>" -width 14 -anchor w -command "helpMsg Text-Fields" \
            -relief flat -padx 0 -pady 0 -borderwidth 0
    pack   .mb.lab -side left -anchor w
    set num 0
    foreach x $multitextflds {
        set lbl [string trimleft $x >]
        button .mb.b$num -text "${lbl}:" -command "switch_txt $x {$multitextflds}"
        pack   .mb.b$num -side left -anchor w
        incr num
    }
    button .mb.insert -text "Insert File..." -command "insert_file .multiline.text"
    pack   .mb.insert -side right -anchor e

    pack   .mb -side top -anchor w -fill x -in $f

    text $f.text -height 12 -width 80 -relief sunken -padx 4 -insertwidth 1 \
            -wrap $TkGnats(TextWrap) -yscrollcommand "$f.sby set" -xscrollcommand "$f.sbx set" \
            -highlightthickness 2 -insertofftime 400 -borderwidth 2 -font $TkGnats(TextFont)
    set TkGnats(mtextbackground) [$f.text cget -background]
    $f.text configure -background $TkGnats(EditFieldBackground)
    
    set_focus_style $f.text
    bind $f.text <Tab>   ""
    scrollbar $f.sby -command "$f.text yview" -relief sunken

    # Create padding based on the y scrollbar width and border
    frame $f.bottom
    scrollbar $f.sbx -command "$f.text xview" -borderwidth 2 -orient horizontal
    set pad [expr [$f.sby cget -width] + 2 * \
            ([$f.sby cget -bd] + [$f.sby cget -highlightthickness])]
    frame $f.pad -width $pad -height $pad

    pack  $f.pad    -in $f.bottom -side left        
    pack  $f.sbx    -in $f.bottom -side bottom -fill x
    pack  $f.bottom -side bottom -fill x 

    pack  $f.sby    -side left  -fill y
    pack  $f.text   -side right -fill both -expand true
    pack  $f        -side top   -fill both -expand true -pady 4
    
    return "$f.text"
}

proc flush_multitext {} {
    global current_multi_text frm
    set f .multiline
    if {"$current_multi_text" != ""} {
        set frm($current_multi_text) "[string trimright [$f.text get 1.0 end] "\t\n "]\n"
    }
}

proc flush_singletext {lst} {
    global frm
    foreach tag $lst {
        set frm($tag) [string trim [textget $tag] "\t\n "]
    }
}

proc switch_txt {name multitextflds} {
    global current_multi_text frm
    set f .multiline

    # write the current text out back into the frm bag
    flush_multitext

    # reset the currently selected button relief and command
    set num [lsearch $multitextflds $current_multi_text]
    if {$num >= 0} {
        .mb.b$num configure -relief raised \
                -command "switch_txt $current_multi_text {$multitextflds}"
    }

    # load the text widget with the new text
    if {[set state [$f.text cget -state]] == "disabled"} {
        $f.text configure -state normal
    }
    $f.text delete 1.0 end
    $f.text insert 1.0 $frm($name)
    if {$state == "disabled"} {
        $f.text configure -state disabled
    }

    # set the newly selected button relief and command
    set current_multi_text $name
    set num [lsearch $multitextflds $current_multi_text]
    .mb.b$num configure -relief sunken -command "helpMsg [string trimleft $current_multi_text >]"
}

proc save_sort_fields {sortfile sortfields} {
    if {$sortfile != ""} {
        set    fout [open $sortfile "w"]
        puts  $fout "set Query(user_sort_flds) \{$sortfields\}"
        close $fout
    }
}

proc insert_file {w} {
    global TkGnats
    set initialdir ""
    if {[info exists TkGnats(InsertFileDir)]} {
        if {[file isdirectory $TkGnats(InsertFileDir)]} {
            set   initialdir  $TkGnats(InsertFileDir)
        }
    }
    if {$initialdir == ""} {
        if {[info exists TkGnats(HOME)]} {
            set initialdir $TkGnats(HOME)
        } {
            set initialdir [pwd]
        }
    }
    set file [tk_getOpenFile -initialdir $initialdir -title "Enter filename to insert"]
    if {$file != ""} {
        set fin [open $file r]
        $w insert insert [read $fin]
        close $fin
    }
}

proc file_search_string {file string} {
    if {[catch {open $file r} fin]} {
        return ""
    }
    set    text [split [read $fin] "\n"]
    close  $fin
    return [lindex $text [lsearch -regexp $text $string]]
}

proc file_get_text {file} {
    if {[catch {open $file r} fin]} {
        return ""
    }
    set    text [read $fin]
    close  $fin
    return [string trimright $text "\n"]
}

proc file_put_text {file text} {
    if {[catch {open $file w} fout]} {
        return ""
    }
    puts   $fout $text
    close  $fout
    return $file
}

proc get_socket_reply {s} {
    set rep [gets $s]
    while {[regexp {^[0-9]+-} $rep]} {
        lappend reply $rep
        set rep [gets $s]
    }
    lappend reply $rep
    return $reply
}

proc check_release_based_batch {} {
    global TkGnats
    catch {eval exec $TkGnats(query-pr) --keywords} rep
    if {[string first "unrecognized option" $rep] < 0} {
        set TkGnats(ReleaseBased) 1
    } {
        set TkGnats(ReleaseBased) 0
    }
}

proc check_release_based_socket {} {
    global TkGnats
    set TkGnats(ReleaseBased) 0
    if {[set s [open_socket_gnatsd]] == "-1"} {
        return -1
    }

    puts $s "KYWD"
    set rep [get_socket_reply $s]
    #puts "rep=$rep"   
    if {[string first "Unrecognized command" [lindex $rep 0]] < 0} {
        set TkGnats(ReleaseBased) 1
    } {
        set TkGnats(ReleaseBased) 0
    }
    
    close_socket $TkGnats(GNATS_SERVER) $TkGnats(GNATS_PORT)
}

proc check_release_based {} {
    global TkGnats
    check_release_based_$TkGnats(GNATS_ACCESS_METHOD)
}

proc get_gnatsd_reply_dot_ended {s} {
    set reply ""
    set rep [gets $s]
    while {$rep != "."} {
        if {[string first "410 Invalid PR " $rep] == 0} {
            # TTD: There's a bug in gnatsd. If you send "SQL2 23 547" and 547 doesn't exist,
            #      it gives 410 error and closes the socket. We need to do one PR at a time.
            #      This just affects selection query and Number field query.
            #      See query_cmd_socket.
            break
        }
        lappend reply $rep
        set rep [gets $s]
    }
    # don't need the dot at the end
    # lappend reply $rep
    return $reply
}
 
proc escape_dots {txt} {
    set txttmp [split $txt \n]
    set len    [llength $txttmp]
    for {set l 0} {$l < $len} {incr l} {
        set line [lindex $txttmp $l]
        if {[string match .* $line]} {
            #puts "escaping this line: $line"
            set txttmp [lreplace $txttmp $l $l .$line]
        }
    }
    set newlen [llength $txttmp]
    if {$len != $newlen} {
        Msg "Internal programming error escaping .'s in message body.\n" \
                "Lines in=$len; lines out=$newlen"
        return $txt
    }
    return [join $txttmp \n]
}

proc unescape_dots {txt} {
    set txttmp [split $txt \n]
    set len    [llength $txttmp]
    for {set l 0} {$l < $len} {incr l} {
        set line [lindex $txttmp $l]
        if {[string match .* $line]} {
            #puts "unescaping this line: $line"
            set txttmp [lreplace $txttmp $l $l [string range $line 1 end]]
        }
    }
    set newlen [llength $txttmp]
    if {$len != $newlen} {
        Msg "Internal programming error unescaping .'s in message body.\n" \
                "Lines in=$len; lines out=$newlen"
        return $txt
    }
    return [join $txttmp \n]
}

proc TkGnats_sendmail {addrs mailtxt} {
    global TkGnats
    return [TkGnats_sendmail_$TkGnats(MailMethod) $addrs $mailtxt]
}

proc TkGnats_sendmail_mailer {addrs mailtxt} {
    global TkGnats
    # sendmail errors are mailed back to sender by sendmail
    if {[catch {open "|$TkGnats(Mailer)" w} fout]} {
        Msg "Error executing mailer \"$TkGnats(Mailer)\":\n" $fout
        return -1
    }
    puts  $fout $mailtxt
    close $fout
    return 0
}

proc TkGnats_sendmail_smtp {addrs mailtxt} {
    global TkGnats
    if {[set s [open_socket $TkGnats(SMTP_SERVER) $TkGnats(SMTP_PORT)]] == "-1"} {
        return -1
    }

    set my_addr $TkGnats(HOSTNAME)
    
    puts $s "HELO $my_addr"
    set rep [get_socket_reply $s]
    #puts "rep=$rep"
    if {![string match 2* [lindex $rep 0]]} {
        Msg "SMTP error sending HELO $my_addr:\n" "[join $rep \n]"
        close_socket $TkGnats(SMTP_SERVER) $TkGnats(SMTP_PORT)
        return -1
    }
    
    set add [lindex [extract_email_address $TkGnats(EmailAddr)] 0]
    puts $s "MAIL FROM: <$add>"
    set rep [get_socket_reply $s]
    #puts "rep=$rep"
    if {![string match 2* [lindex $rep 0]]} {
        Msg "SMTP error sending MAIL FROM: <$add>\n" "[join $rep \n]"
        close_socket $TkGnats(SMTP_SERVER) $TkGnats(SMTP_PORT)
        return -1
    }

    foreach addr [split $addrs ,] {
        set add [lindex [extract_email_address $addr] 0]
        if {$add == {}} {
            continue
        }
        puts $s "RCPT TO: <$add>"
        set rep [get_socket_reply $s]
        #puts "rep=$rep"
        if {![string match 2* [lindex $rep 0]]} {
            Msg "SMTP error sending RCPT TO: <$add>\n" "[join $rep \n]"
            close_socket $TkGnats(SMTP_SERVER) $TkGnats(SMTP_PORT)
            return -1
        }
    }

    set mailtxt [escape_dots $mailtxt]
    
    puts $s "DATA"
    set rep [get_socket_reply $s]
    #puts "rep=$rep"
    if {![string match 3* [lindex $rep 0]]} {
        Msg "SMTP error sending DATA:\n" "[join $rep \n]"
        close_socket $TkGnats(SMTP_SERVER) $TkGnats(SMTP_PORT)
        return -1
    }
    
    puts $s $mailtxt
    puts $s "."
    set rep [get_socket_reply $s]
    #puts "rep=$rep"
    if {![string match 2* [lindex $rep 0]]} {
        Msg "SMTP error sending complete message:\n" "[join $rep \n]"
        close_socket $TkGnats(SMTP_SERVER) $TkGnats(SMTP_PORT)
        return -1
    }
    #puts "message=$mailtxt"
    
    close_socket $TkGnats(SMTP_SERVER) $TkGnats(SMTP_PORT)

    return 0
}

proc email_originator_send {prid textw top} {
    global TkGnats bugsval respval origval mail_cc replvals mail_sj
    
    if {[string trim [$textw get 1.0 end]] == ""} {
        Msg "The body of the message is blank."
        return
    }

    set addrs ""
    foreach a "bugsval respval origval mail_cc" {
        if {"[string trim [subst $$a]]" != ""} {
            if {"$addrs" != ""} {
                set addrs "$addrs, "
            }
            set addrs "$addrs[string trim [subst $$a]]"
        }
    }
    for {set i 1} {$i <= $replvals(nreps)} {incr i} {
        set a [string trim $replvals($i)]
        if {"$a" != ""} {
            if {"$addrs" != ""} {
                set addrs "$addrs, "
            }
            set addrs "$addrs$a"
        }
    }

    set mailtxt ""
    append mailtxt "From: $TkGnats(EmailAddr)\n"
    append mailtxt "Reply-To: $TkGnats(EmailAddr)\n"
    append mailtxt "To: $addrs\n"
    append mailtxt "Subject: Re: $prid: $mail_sj\n"
    append mailtxt "\n"
    append mailtxt "[$textw get 1.0 end]"

    if {[TkGnats_sendmail $addrs $mailtxt] == 0} {
        destroy $top
    }

    return
}

proc email_originator {to_rep to_res to_org prid synopsis} {
    global TkGnats mail_cc mail_sj bugsval respval origval replvals

    # expand the Responsible address, which could be an alias in the responsibles file

    set tmp_res [lindex [extract_email_address $to_res] 0]
    set tmp_org [lindex [extract_email_address $to_org] 0]
    set tmp_usr [lindex [extract_email_address $TkGnats(EmailAddr)] 0]

    set responsible_code [catch {get_responsible_addr $tmp_res} to_res_addr]
    if {$responsible_code} {
        set to_res_addr ""
        Msg "Could not verify E-mail address of responsible party.\n" \
                "Address used: $tmp_res.\n" "Resulting error(s):\n" "$to_res_addr"
        return -1
    }
    if {"$tmp_res" != "$to_res_addr"} {
        set restmp "$tmp_res: $to_res_addr"
    } {
        set restmp "$tmp_res"
    }
    set to_res "$to_res_addr"
    
    set tlist {}
    
    set t [toplevel .tkgnats_email]
    wm minsize    $t 100 100
    wm title      $t "TkGnats - Send Email to Problem Report: $prid"
    wm iconbitmap $t @$TkGnats(lib)/tkeditpr.xbm
    wm iconname   $t "$TkGnats(LogName)'s tkemailpr [file tail $prid]"

    set   f [frame $t.mframe -borderwidth 1 -relief raised]
    pack $f -side top -fill x

    menubutton $f.file -text "File" -menu $f.file.m -underline 0
    menu       $f.file.m
    $f.file.m add command -label "Send"  \
            -command "email_originator_send $prid $f.text $t"
    $f.file.m add separator
    $f.file.m add command -label "Cancel" -command "destroy $t"
    
    menubutton $f.edit -text "Edit" -menu $f.edit.m -underline 0
    menu       $f.edit.m
    $f.edit.m add command -label "Fonts..." -command "edit_fonts"
    
    pack $f.file $f.edit -side left
    
    menubutton $f.help -text "Help" -menu $f.help.m -underline 0
    menu       $f.help.m
    pack       $f.help -side right
    $f.help.m add command -label "View Configuration Variables" \
        -command "helpMsg TkGnats_Variables"
    $f.help.m add separator
    $f.help.m add command -label "About" \
            -command "helpMsg TkGnats_About"

    set    f [frame $t.f]
    pack  $f           -side top  -fill both -expand true

    set     b [frame $f.b -borderwidth 1 -relief raised]
    pack   $b -side top -fill x -anchor w
    #button $b.cancel -borderwidth 1 -text Cancel -command "destroy $t"
    button $b.send   -borderwidth 1 -text Send   \
            -command "email_originator_send $prid $f.text $t"
    pack   $b.send   -side left -padx 0 -pady 0
    #pack   $b.cancel -side left -padx 0 -pady 0

    frame $f.ad
    pack  $f.ad        -side top  -anchor n -fill x
    frame $f.ad.lab
    pack  $f.ad.lab    -side left -anchor w -fill y
    frame $f.ad.ent
    pack  $f.ad.ent    -side left -anchor w -fill x -expand true
    
    label $f.ad.lab.to   -relief flat -anchor e -text "To:" -width 8
    pack  $f.ad.lab.to   -side top    -anchor n

    label $f.ad.lab.sj   -relief flat -anchor e -text "Subject:"
    pack  $f.ad.lab.sj   -side bottom -anchor s -pady 2
    
    label $f.ad.lab.cc   -relief flat -anchor e -text "Cc:" -width 8
    pack  $f.ad.lab.cc   -side bottom -anchor s -pady 2
    
    checkbutton $f.ad.ent.to -relief flat -pady 0 -highlightthickness 0 -anchor w \
            -variable bugsval -text "$TkGnats(GNATS_ADDR)" \
            -offvalue "" -onvalue "$TkGnats(GNATS_ADDR)"
    pack        $f.ad.ent.to -side top -anchor w
    
    checkbutton $f.ad.ent.resp -relief flat -pady 0 -highlightthickness 0 -anchor w \
            -variable respval  -text "Responsible   ($restmp)" -offvalue "" -onvalue "$to_res"
    pack        $f.ad.ent.resp -side top -anchor w
    checkbutton $f.ad.ent.orig -relief flat -pady 0 -highlightthickness 0 -anchor w \
            -variable origval  -text "Originator    ($to_org)" -offvalue "" -onvalue "$to_org"
    pack        $f.ad.ent.orig -side top -anchor w

    set reps  [split $to_rep ,]
    set nreps [llength $reps]
    set nrep  0
    catch {unset replvals}
    for {set i 0} {$i < $nreps} {incr i} {
        set rep     [string trim [lindex $reps $i]]
        set tmp_rep [lindex [extract_email_address $rep] 0]
        if {"$tmp_rep" == "$tmp_org"} {
            continue
        }
        incr nrep
        set replvals($nrep) $rep
        checkbutton $f.ad.ent.repl_$nrep -relief flat -pady 0 -highlightthickness 0 -anchor w \
                -variable replvals($nrep)  -text "Reply-To      ($rep)" -offvalue "" -onvalue "$rep"
        pack        $f.ad.ent.repl_$nrep -side top -anchor w
    }
    set replvals(nreps) $nrep

    lappend tlist [entry $f.ad.ent.cc -relief sunken -borderwidth 2 \
            -background $TkGnats(EditFieldBackground) \
            -highlightthickness 2 -textvariable mail_cc]
    pack  $f.ad.ent.cc -side top -anchor w -fill x -expand true
    set_focus_style $f.ad.ent.cc
    
    frame $f.ad.ent.sj
    pack  $f.ad.ent.sj -anchor w -fill x -expand true
    label $f.ad.ent.sj.def -relief sunken -anchor w -text "Re: $prid:"
    pack  $f.ad.ent.sj.def -side left
    lappend tlist [entry $f.ad.ent.sj.ent -relief sunken -borderwidth 2 \
            -background $TkGnats(EditFieldBackground) \
            -highlightthickness 2 -textvariable mail_sj]
    pack  $f.ad.ent.sj.ent -side left -anchor w -fill x -expand true
    set_focus_style $f.ad.ent.sj.ent

    scrollbar $f.sb -command "$f.text yview" -relief sunken
    # The text entry is hardwired to no wrap because the wrap is only visual anyway
    # (no LF's are actually inserted)
    lappend tlist [text $f.text \
        -wrap none \
        -yscrollcommand "$f.sb set" \
        -height 30 -width 80 -relief sunken -padx 4 -insertwidth 1 \
        -insertofftime 400 -borderwidth 2 -highlightthickness 2 -background $TkGnats(EditFieldBackground)]
    set_focus_style $f.text

    set_text_traversal $tlist
    
    pack $f.sb   -side left  -fill y
    pack $f.text -side right -expand true -fill both

    focus $f.text

    set bugsval "$TkGnats(GNATS_ADDR)"

#   if {$tmp_res != $tmp_usr}
    if {$to_res != $tmp_usr} {
        set respval $to_res
    } {
        set respval ""
        $f.ad.ent.resp configure -state disabled
    }
    if {$tmp_org != $tmp_usr && $tmp_org != $tmp_res} {
        set origval $to_org
    } {
        set origval ""
        $f.ad.ent.orig configure -state disabled
    }

#dputs "tmp_usr=$tmp_usr tmp_res=$tmp_res to_res=$to_res tmp_org = $tmp_org to_org = $to_org"

    # Disable any duplicate recipients
#dputs "nrep=$nrep"
    for {set i 1} {$i <= $nrep} {incr i} {
        set tmp_rep [lindex [extract_email_address $replvals($i)] 0]
#dputs "replvals($i)=$replvals($i) tmp_rep=$tmp_rep"
        if {$tmp_rep == $tmp_usr || "$tmp_rep" == "$tmp_res"} {
            set replvals($i) ""
            $f.ad.ent.repl_$i configure -state disabled
        }
    }
    
    set mail_cc ""
    set mail_sj "$synopsis"
}

proc entryDialog {msg {no_cancel ""} {initial_value ""}} {
    global  entryDialog_Value
    set entryDialog_Value ""
    catch  {destroy  .entryDialog}
    set t  [toplevel .entryDialog -borderwidth 2 -relief raised]
    message $t.msg -text $msg -aspect 99999
    entry   $t.e   -width 50 -borderwidth 2 -relief sunken -highlightthickness 2
    frame   $t.bar 
    button  $t.bar.ok     -text "OK"     -command "set entryDialog_Value \[$t.e get\]"
    pack    $t.bar.ok -side left -padx 8 -pady 8
    if {$no_cancel == ""} {
        button  $t.bar.cancel -text "Cancel" -command "set entryDialog_Value {}"
        pack    $t.bar.cancel -side left -padx 8 -pady 8
    }
    pack    $t.msg -side top -fill x
    pack    $t.e   -side top -padx 8 -pady 8
    pack    $t.bar -side bottom -anchor center
    bind    $t.e <KeyPress-Return> "set entryDialog_Value \[$t.e get\]"
    set_focus_style $t.e
    focus   $t.e
    $t.e insert 0 $initial_value
    set done 0
    while {$done == 0} {
        grab    $t
        tkwait  variable entryDialog_Value
        grab    release $t
        if {$no_cancel != "" && $entryDialog_Value == ""} {
            bell
            Msg "Blank entered!" "You must enter a value."
            set done 0
        } {
            set done 1
        }
    }
    destroy $t
    update idletasks
    return  $entryDialog_Value
}

proc quickfill_entry_from_listbox {ab ew lw vlist} {
    upvar 1 $ab tvar
    set cur [$lw curselection]
    if {$tvar == "" && $cur == ""} {
        return
    }
    set eidx   [$ew index insert]
    set tmpval [string range [$ew get] 0 [expr $eidx - 1]]
    if {$tmpval != ""} {
        set tvar $tmpval
    }
    set lidx [lsearch -glob $vlist $tvar*]
    if {$lidx < 0 || $tvar == ""} {
        if {$cur != ""} {
            set tvar [$lw get $cur]
        } {
            set tvar [string range [$ew get] 0 [expr $eidx - 2]]
        }
        set lidx [lsearch -glob $vlist $tvar*]
        incr eidx -1
        bell
    }
    $lw selection clear 0 end
    if {$tvar != ""} {
        if {$lidx >= 0} {
            $lw selection set $lidx
            $lw see $lidx
            set tvar [$lw get [$lw curselection]]
        }
    }
    set tmpval   $tvar
    $ew delete 0 end
    $ew insert 0 $tmpval
    $ew icursor  $eidx
    if {$eidx > 0} {
        $ew selection range $eidx [string length $tmpval]
    }
}

proc save_help {w} {
    set file [tk_getSaveFile]
    if {$file != ""} {
        if {[file_put_text $file [$w get 1.0 end]] == ""} {
            Msg "Unable to save help text to file \"$file\"."
        } {
            Msg "Saved help text to file \"$file\"."
        }
    } {
        Msg "Save help text aborted."
    }
}
    
proc show_help {title help} {
    global TkGnats
    set w .help_$title
    catch {destroy $w}
    
    regsub -all "_" $title " " Title

    toplevel  $w
    wm title  $w "$Title Help"

    frame     $w.opts
    pack      $w.opts -side top
    button    $w.opts.quit -text "OK" -command "destroy $w"
    button    $w.opts.save -text "Save to file..." -command "save_help $w.text"
    pack      $w.opts.quit $w.opts.save -side left -pady 2 -padx 20

    # Create a scrollbar and a text box in the main window.
    scrollbar $w.scrollx -orient horiz -command "$w.text xview"
    pack      $w.scrollx -side bottom -fill x
    scrollbar $w.scrolly -command "$w.text yview"
    pack      $w.scrolly -side right  -fill y
    text      $w.text -relief sunken -bd 2 -yscrollcommand "$w.scrolly set" \
            -xscrollcommand "$w.scrollx set" -setgrid 1 -height 24 -width 82 \
            -font $TkGnats(helpfont)
    pack      $w.text -side left -fill both -expand yes
    $w.text   insert end $help
    set nlines [lindex [split [$w.text index end] "."] 0]
    set height 24
    if {$height > $nlines} {
        set height $nlines
    }
    $w.text   configure -state disabled -height $height
}

proc extract_email_address {addr} {
    # Supported formats:
    # 01: "Rick Macdonald" <rickm@vsl.com>
    #     Rick Macdonald <rickm@vsl.com>
    # 02: rickm@vsl.com (Rick Macdonald)
    # 03: rickm@vsl.com
    #
    #     01 and 02 return: {rickm@vsl.com} {Rick Macdonald}
    #     03 returns: {rickm@vsl.com} {}
    set fmt01_exp {^(.*[^<]+)(<.*>)}
    set fmt02_exp {^(.*[^\(]+)(\(.*\))}
    set fmt03_exp {(.*)}
    set name    ""
    set address ""
    if {![regexp $fmt01_exp $addr matched name address]} {
        if {![regexp $fmt02_exp $addr matched address name]} {
            set address $addr
        }
    }
    return [list [string trim $address "()<>\"\'        \n"] \
            [string trim $name "()<>\"\'        \n"]]
}

proc extract_full_name_from_address {addr} {
    set name [extract_email_address $addr]
    if {[lindex $name 1] != {}} {
        return [lindex $name 1]
    } {
        return $addr
    }
}

proc lock_pr_batch {me prid txt} {
    global TkGnats
    upvar 1 $txt text
    return [catch {eval exec $TkGnats(pr-edit) $TkGnats(UseridPassword) --lock $me $prid} text]
}

proc lock_pr_socket {me prid txt} {
    global TkGnats
    upvar 1 $txt text
    if {[set s [open_socket_gnatsd]] == "-1"} {
        set text "Can't open socket $TkGnats(GNATS_SERVER) $TkGnats(GNATS_PORT)"
        return 1
    }
    puts $s "LOCK $prid $me"
    set rep [get_socket_reply $s]
    #puts "rep=$rep"
    if {![string match 2* [lindex $rep 0]]} {
        set text [lindex $rep 0]
        return 1
    }
    set text [join [get_gnatsd_reply_dot_ended $s] \n]
    if {[string match 4* $text]} {
dputs "error return"
        return 1
    }
dputs "calling close"    
    close_socket $TkGnats(GNATS_SERVER) $TkGnats(GNATS_PORT)
    set text [unescape_dots $text]
    return 0
}

proc lock_pr {prid} {
    global TkGnats

    ### find a username@hostname

    set me $TkGnats(LogName)

    if {"$TkGnats(HOSTNAME)" != ""} {
        set me "$me@$TkGnats(HOSTNAME)"
    }

    ### lock the PR and bail out if the lock fails

    set stat [lock_pr_$TkGnats(GNATS_ACCESS_METHOD) $me $prid text]
    #puts "stat=$stat text=$text"        
    if {$stat == 0} {
        set prtxt $text
    } {
        wm withdraw .
        if {[string first "locked by" $text] >= 0} {
            # gnatsd, npr-edit, pr-edit
            Msg "Problem report '$prid' is locked by '[lindex [split $text] end]'"
        } { 
            Msg "Can't lock problem report '$prid':\n\n$text"
        }
        exit 1
    }

    return $prtxt
}

proc unlock_pr_batch {prid} {
    global TkGnats
    catch {eval exec $TkGnats(pr-edit) $TkGnats(UseridPassword) --unlock $prid} rep
    return $rep
}

proc unlock_pr_socket {prid} {
    global TkGnats
    if {[set s [open_socket_gnatsd]] == "-1"} {
        return "Error-3 opening socket/port $TkGnats(GNATS_SERVER) $TkGnats(GNATS_PORT)"
    }
    puts $s "UNLK $prid"
    set rep [get_socket_reply $s]
    if {![string match 2* [lindex $rep 0]]} {
        set rep [lindex $rep 0]
    } {
        set rep ""
    }
    close_socket $TkGnats(GNATS_SERVER) $TkGnats(GNATS_PORT)
    return $rep
}

proc unlock_pr {prid} {
    global TkGnats
    set rep [unlock_pr_$TkGnats(GNATS_ACCESS_METHOD) $prid]
    if {$rep != ""} {
        Msg "Error unlocking PRID $prid:\n\n$rep"
    }
}

proc get_pr_full_text {prid} {
    global TkGnats
    return [get_pr_full_text_$TkGnats(GNATS_ACCESS_METHOD) $prid]
}

proc get_pr_full_text_batch {prid} {
    global TkGnats
    if {[catch {eval exec $TkGnats(query-pr) $TkGnats(UseridPassword) --full [file tail $prid]} rep]} {
        Msg "GNATS error getting full text of PRID $prid:\n\n$rep"
        return -1
    }
    return $rep
}

proc get_pr_full_text_socket {prid} {
    global TkGnats
    if {[set s [open_socket_gnatsd]] == "-1"} {
        return "-1"
    }
    puts $s "RSET"
    set rep [get_socket_reply $s]
    if {![string match 2* [lindex $rep 0]]} {
        Msg "GNATSD error sending RSET getting full text of PRID $prid:\n" "[join $rep \n]"
        return -1
    }
    puts $s "FULL $prid"
    set rep [get_socket_reply $s]
    if {![string match 2* [lindex $rep 0]]} {
        Msg "GNATSD error getting full text of PRID $prid:\n" "[join $rep \n]"
        return -1
    }
    set plist [join [get_gnatsd_reply_dot_ended $s] \n]
    close_socket $TkGnats(GNATS_SERVER) $TkGnats(GNATS_PORT)
    return [unescape_dots $plist]
}

proc get_pr_medium_text {prid} {
    global TkGnats
    return [get_pr_medium_text_$TkGnats(GNATS_ACCESS_METHOD) $prid]
}

proc get_pr_medium_text_batch {prid} {
    global TkGnats
    return [eval exec $TkGnats(query-pr) $TkGnats(UseridPassword) [file tail $prid]]
}

proc get_pr_medium_text_socket {prid} {
    global TkGnats
    if {[set s [open_socket_gnatsd]] == "-1"} {
        return "-1"
    }
    puts $s "RSET"
    set rep [get_socket_reply $s]
    if {![string match 2* [lindex $rep 0]]} {
        Msg "GNATSD error sending RSET getting full text of PRID $prid:\n" "[join $rep \n]"
        return -1
    }
    puts $s "QURY $prid"
    set rep [get_socket_reply $s]
    if {![string match 2* [lindex $rep 0]]} {
        Msg "GNATSD error getting medium text of PRID $prid:\n" "[join $rep \n]"
        return -1
    }
    set plist [join [get_gnatsd_reply_dot_ended $s] \n]
    close_socket $TkGnats(GNATS_SERVER) $TkGnats(GNATS_PORT)
    
    return $plist
}

proc delete_pr {prid} {
    global TkGnats
    return [delete_pr_$TkGnats(GNATS_ACCESS) $prid]
}

proc delete_pr_network {prid} {
    global TkGnats
    bell
    Msg "delete_pr is only available for GNATS_ACCESS=local"
    return "delete_pr is only available for GNATS_ACCESS=local"
}

proc delete_pr_local {prid} {
    global TkGnats
# TTD: This is missing a global lock on the gnats database!
# TTD: This is missing a global lock on the gnats database!
# TTD: some things here need re-ordering (lock_pr, etc)
# TTD: some things here need re-ordering (lock_pr, etc)
    set INDEX $TkGnats(GNATS_ROOT)/gnats-adm/index

    set prtext  [get_pr_medium_text $prid]
    parsepr_txt $prtext flds
    set full_id [string trim $flds(>Category)]/$prid

    if {"$full_id" == ""} {
        #####wm withdraw .
        Msg "Error accessing problem report '$prid'!"
        return ""
    }

    set pr $TkGnats(GNATS_ROOT)/$full_id

    if {![file writable $INDEX] || ![file writable $pr]} {
        Msg "You don't have proper file permissions to delete $full_id."
        return ""
    }

    set   state  [string trim $flds(>State)]
    if {"$state" != "closed"} {
        Msg "Problem reports must be closed before deleting."
        unlock_pr $full_id
        return ""
    }
    
    bell
    if {[tk_dialog .tkquerypr_delete "Confirm_Delete" \
            "This will PERMANENTLY delete this bug report.\n\nAre you sure?" \
            "warning" -1 "Delete Report" "Cancel"] != 0} {
        return ""
    }
    
    lock_pr $full_id
    
    # take the relevant line out of the index - it should only be there once

    set stamp tkdeletepr.$TkGnats(LogName).[clock format [clock seconds] -format "%j:%T"]
    # catch {exec egrep -v ^$full_id: $INDEX > $INDEX.$stamp}
    set index [split [file_get_text $INDEX] \n]
    if {"$index" == ""} {
        Msg "Unable to read GNATS index."
        return ""
    }
    set idx [lsearch -regexp $index ^$full_id:]
    if {$idx < 0} {
        Msg "Problem report '$prid' not found in GNATS index!"
        return ""
    }
    set index [lreplace $index $idx $idx]
    set idx [lsearch -regexp $index ^$full_id:]
    if {$idx >= 0} {
        Msg "Problem report '$prid' seems to exist more than once in the GNATS index!"
        return ""
    }
    if {[file_put_text $INDEX.$stamp [join $index \n]] == ""} {
        Msg "Unable to write temporary GNATS index file."
        return ""
    }
    
    # here's where we actually delete the file.
    file rename -force $INDEX $INDEX.bak
    file delete $pr
    file rename -force $INDEX.$stamp $INDEX

    # It doesn't seem necessary to send mail about this
    
    # call PR_EDIT on the new file and clean up
    unlock_pr $full_id
    
    return "All references to $full_id now deleted."
}

proc chk_fld {fldname val {flag_if_missing 1}} {
    global mlist
    upvar 1 $fldname fld
    if {![info exists fld]} {
        if {$flag_if_missing} {
            set match ""
            regexp "\\(.*\\)" $fldname match
            set match [string trim $match ()]
            if {$match != ""} {
                lappend mlist $match
            }
        }
        set fld $val
    }
}

proc load_field_defaults {field_array} {
    global TkGnats mlist
    
    upvar 1 $field_array field

    set mlist {}
    
    chk_fld field(>State)         [lindex $TkGnats(StatesList) 0]
    chk_fld field(>Confidential)  no
    chk_fld field(>Severity)      serious
    chk_fld field(>Priority)      medium
    chk_fld field(>Class)         [lindex $TkGnats(ClassesList) 0]
    chk_fld field(>Arrival-Date)  [clock format [clock seconds]]
    chk_fld field(>Last-Modified) None
    chk_fld field(>Closed-Date)   None
    chk_fld field(>Originator)    Unknown
    chk_fld field(>Responsible)   gnats
    chk_fld field(>Category)      pending
    chk_fld field(>Synopsis)      None
    chk_fld field(>Release)       Unknown
    chk_fld field(>Description)   None
    chk_fld field(>Environment)   "\n"
    chk_fld field(>Audit-Trail)   "\n"
    chk_fld field(>How-To-Repeat) "\n"

    chk_fld field(Reply-To)       nobody

    # It's ok if these are missing
    chk_fld field(>Unformatted)   "\n" 0
    chk_fld field(>Fix)           "\n" 0
    chk_fld field(>Release-Note)  "\n" 0

    if {$TkGnats(ReleaseBased)} {
        chk_fld field(>Keywords)          ""
        chk_fld field(>$TkGnats(Quarter)) ""
        chk_fld field(>Date-Required)     ""
    }

    return $mlist
}

TkGnats_config
