#!/bin/sh

## "guild"
## Graphical User Interface to LIGO Databases
## Written by Peter Shawhan, Dec. 1999 - Oct. 2000
# RCS: @(#) $Id: guild,v 1.118 2009/06/09 13:39:21 pshawhan Exp $

## This script is a hybrid of sh and Tcl/Tk commands.

## Use "wishexe" if it is in the PATH, otherwise use "wish" #\
shell=wish                                                  #\
for dir in `echo $PATH | perl -p -e "s/:/ /g"`; do          #\
  if test -x $dir/wishexe; then shell=wishexe; fi           #\
done                                                        #\
exec $shell "$0" ${1+"$@"}                                  #\

##==========================================================================
## "guild":
## Graphical User Interface to LIGO Database.
## Created by Peter Shawhan.
## Documentation last updated May 12, 2000 by Peter Shawhan.
## .
##
## General notes:
## .
## guild is written entirely in Tcl/Tk, without using any C code or
## extensions to the Tcl/Tk core.  It requires Tcl/Tk version 8.3b1 or later
## and will complain if you try to run it under an earlier version.  All of
## the code is currently kept in a single file.
## If the "wish" executable in your $path is version 8.3b1 or later, you 
## should be able to run this script without any modification.  If the "wish"
## executable in your path is an earlier version, but you have a recent
## version somewhere else on the system, then you can point to it with the
## preferred_wish variable near the beginning of this script.
## .
## guild starts out with a main window containing a set of buttons.  Each
## of these buttons opens an additional window, usually a dialog with
## a variety of options to construct a database query.  When the query is
## submitted, the results are displayed in yet another window.  This
## philosophy of opening an additional window for each operation is
## designed to let the user keep control over what is on the screen (say,
## information retrieved from a few different database tables) and
## incrementally modify queries as necessary, though it also means that
## they have to explicitly close windows when they are done with them.
## .
## The internal structure of guild is believed by the author to
## be pretty solid, though not airtight.  The scrolledtable
## pseudo-widget code has its own namespace and handles multiple
## instances easily; it could be useful in other applications
## (and can be made available as a separate Tcl "package"), although 
## there has been little effort to add features other than those required
## by guild.  guild itself is, obviously, customized to optimally
## display the contents of the tables currently in the LDAS metadata
## database, but all of the table-specific code is confined to only four
## routines:
##   1. MakeMainButtons
##   2. SetupQualifiers
##   3. SetupCrossrefs
##   4. SetupActions (plus some table-specific helper routines)
## ;#ol
## These routines have been written in such a way that it should be pretty
## obvious how to modify them if tables are added or if table definitions
## change.
## .
## Call trees for major parts of code:
## .  
## GuildMain:
## ___SetupDisplay.
## ___SetupMainWindow.
## ___WebPatchCheck.
## ___GuildStartup:
## ______WebPatchWorkarounds.
## ______ReadGuildRc.
## ______CreateImages:
## _________Iconbmp_* (several procs).
## ______Db2Setup.
## ______MakeMenu.
## _________GetUrlToOpen (via a menu choice).
## _________SetFontSize (via a menu choice).
## ______MakeMainPulldowns.
## ______MakeMainButtons:
## _________MainMenubutton.
## _________AddBuildQueryDialog.
## ______DisplayMessages:
## _________VersionMessages.
## _________InfoMessages.
## ______WriteGuildRc.
## .
## BuildQueryDialog:
## ___KeyModifiesEntry.
## ___SetupQualifiers:
## ______SetMaxFetch.
## ______SetOrderBy.
## ______CompareText:
## _________KeyModifiesEntry.
## ______CompareNumeric:
## _________KeyModifiesEntry.
## _________EntryAddAnd.
## _________EntryRemoveAnd.
## ______CompareJobNum:
## _________KeyModifiesEntry.
## ______DistinctOption.
## ___BuildQuery:
## ______HandleTimeString:
## _________gpsTime.
## ___DB2Submit (via a button).
## ______ManagerSubmit.
## .
## BuildDataQueryDialog:
## ___BuildDataQuery:
## ______Uniquify.
## ______HandleTimeString:
## _________gpsTime.
## ___ManagerSubmit (via a button).
## .  
## ManagerSubmit:
## ___GetDbUser (first time only).
## ___JobAdd:
## ______StartElapsedLoop:
## _________ElapsedLoop (re-schedules itself).
## ___JobMsgConnect (as handler for listening socket).
## ______JobMsgHandle (as handler for job output from manager).
## _________UseJobResults:
## ___________JobUpdate:
## ______________JobRemove (if an error message or one-line job result).
## ___________GeturlWhole (in some cases).
## ___________DisplayFile (see call tree below).
## ___________ListboxEntryLinks (if appropriate).
## ___________JobRemove.
## ___JobUpdate.
## ___JobInfoHandle (as handler for job information message from manager).
## .
## DisplayFile:
## ___GeturlWhole (in some cases).
## ___ParseChannelList
## ___ParseXml:
## ______BuildXmlParser.
## ___ParseIlwd:
## ______BinaryNullMask.
## ___JobUpdate (if there is an error message or one-line job result).
## ___DisplayScrolledtable:
## ______TableSaveDialog, TableSave (via a button).
## ______scrolledtable::scrolledtable.
## ______SetupCrossrefs:
## _________CrossrefMenubutton.
## _________AddCrossref:
## ____________ReplaceNullEquality.
## _________StdCrQ.
## ______CrossrefPossible.
## ______SetupActions.
## ___DisplayNamevalue.
## ___DisplayListbox.
## .

##=========================================================================
## Name: Package requirements and global parameters
##
## Comments:
##   guild requires the scrolledtable package.  At present it is
##   kept in the same file.

;#barecode

#source combobox.tcl
#package require combobox 

###;##- Append the directory in which the script is located to the list
###;##- for locating packages.
###lappend auto_path [file dirname [info script]]

;##- scrolledtable package routines are currently in this file
###package require scrolledtable

;##- Comment this out in guild 3.7.0 since the http package is now explicitly
;##- included in the guild script file
###package require http 2.2

;##- Set some global parameters
set guildVersion 4.0.0
set guildPatchVersion ""
set guildPatchStatus ""
set httpPatchDir "http://www.ldas-sw.ligo.caltech.edu/guild/patches"
# I modified the http package code in this file so that the timeout (in ms)
# is for connection only; once a connection is made, the timeout counter
# is removed.  So this won't interrupt a transfer in progress.
set httpPatchTimeout 10000
set fgColor black
set bgColor gray85
set activeBg gray93
set troughColor gray75
set statusBgIdle $bgColor
set statusBgRun yellow
set statusBgError red
set guildListenIP ""
set guildListenPort 0
set guildJobCounter 0
set guildJobsActive {}
set guildJobsError {}

;#end  

##=========================================================================
## Name: GuildMain
##
## Description:
##   Main driver routine for guild.  Calls other routines to set up the
##   main window, then waits for user-generated events.
##
## Usage:
##   GuildMain
##
## Comments:
##   Checks that the user is running a recent enough version of Tcl/Tk,
##   and bails out if not.  Calls MakeMenu, Db2Setup, and MakeMainButtons.

proc GuildMain {} {

    ;##- Check that the user is running a recent enough version of Tcl/Tk
    set tclversion [info tclversion]
    set patchlevel [info patchlevel]
    ;##- Trim off the version from the patchlevel string
    set patchlevel [ string replace $patchlevel 0 \
	    [expr {[string length $tclversion]-1}] ]
    if { $tclversion<8.3 || \
	    ($tclversion==8.3 && [string match a* $patchlevel]) } {
	puts stderr "You are running Tcl/Tk version [info patchlevel]"
	puts stderr "guild requires Tcl/Tk version 8.3b1 or later"
	exit
    }

    ;##- Check command line for options to override color defaults, etc.
    set ::showfiles [list]
    set lastarg ""
    foreach arg $::argv {
	if [string match -* $arg] {
	    #-- This introduces an option
	    set lastarg $arg
	} else {
	    switch -glob -- $lastarg {
		-foreground -
		-fg {
		    set ::fgColor $arg
		    set lastarg ""
		}
		-background -
		-bg {
		    set ::bgColor $arg
		    set lastarg ""
		}
		-activebackground -
		-activebg {
		    set ::activeBg $arg
		    set lastarg ""
		}
		-troughcolor {
		    set ::troughColor $arg
		    set lastarg ""
		}
		default {
		    #-- Take this to be a file to be opened
		    lappend ::showfiles $arg
		}
	    }
	}
    }

    ;##- Set global variables, etc., which control display properties
    SetupDisplay

    ;##- Set some version-dependent flags
    if {[CompareVersions [info patchlevel] < 8.4]} {
	set ::entrydis disabled
    } else {
	set ::entrydis readonly
    }

    ;##- Set up the main window
    SetupMainWindow

    ;##- Check web site for any needed patches
    set upURL "$::httpPatchDir/guild${::guildVersion}_patches"
    UpdateStatus "Checking web site for patches"
    WebPatchCheck $upURL

    ;##- Finish the startup process (with routines which may be web-patched)
    GlobusInit
    GuildStartup

    ;##- We're done setting things up...now wait for user-generated events!
    return
}


##=========================================================================
## Name: SetupDisplay
##
## Description:
##   Set up initial display properties.
## 
## Parameters:
##   none
##
## Usage:
##   SetupDisplay
##
## Comments:
##   Called by GuildMain BEFORE web-patching.

proc SetupDisplay {} {

    ;##- Set up fonts
    font create normfont -family courier -size 12
    font create boldfont -family courier -size 12 -weight bold
    font create normhelv -family helvetica -size 12
    font create bighelv -family helvetica -size 36

    ;##- Set defaults in resource database
    option add *foreground $::fgColor userDefault
    option add *activeForeground $::fgColor userDefault

    option add *background $::bgColor userDefault
    option add *highlightBackground $::bgColor userDefault
    set ::statusBgIdle $::bgColor

    option add *activeBackground $::activeBg userDefault

    option add *troughColor $::troughColor userDefault

    option add *font normfont

    ;##- See if we should create icons for the windows
###    puts "os is $::tcl_platform(os)"
    if { [regexp -nocase {(windows|macos)} $::tcl_platform(os)] } {
	set ::winIcons 0
    } else {
	set ::winIcons 1
    }

    return
}

##=========================================================================
## Name: SetupMainWindow
##
## Description:
##   Create logo and status area, plus frames which will later hold
##   buttons, etc.
## 
## Parameters:
##   none
##
## Usage:
##   SetupMainWindow
##
## Comments:
##   Called by GuildMain BEFORE web-patching.

proc SetupMainWindow {} {

    . config -bg $::bgColor

    frame .title
    label .title.program_name -justify center -font bighelv -text "guild"
    message .title.program_description -justify center -font normhelv \
	    -aspect 10000 -text "Graphical User Interface\nto LIGO Databases"
    pack .title.program_name -side left
    pack .title.program_description -side left

    ;##- Set up area for pulldown menus
    frame .pulls

    ;##- Set up button area
    frame .barea

    ;##- Set up status area
    frame .statuspad
    text .status -font normhelv -width 20 -height 1 -state disabled

    ;##- Record the original background of the status area, since we will
    ;##- change it later
    set ::statusBgIdle [.status cget -background]

    ;##- Lay out the frames in the main window
    grid .title
    grid .pulls
    grid .barea
    grid .statuspad -sticky news -pady 6
    grid .status -sticky news
    grid rowconfigure . 2 -weight 1
    grid columnconfigure . 0 -weight 1

    return
}

##=========================================================================
## Name: WebPatchCheck
##
## Description:
##   Routine to download a file of Tcl code from a URL and eval it.
## 
## Parameters:
##   url -- URL to download
##
## Usage:
##   WebPatchCheck url
##
## Comments:
##   Called by GuildMain.
##   Returns one of the following:
##     1. "OK"
##     3. "no_file"
##     2. "no_connect"
##     1. "no_server"
## ;#ol

proc WebPatchCheck { url } {

    #-- We may need to loop, if there is URL redirection
    set origurl $url
    while { 1 } {

    if { [catch {http::geturl $url -timeout $::httpPatchTimeout} httpvar] } {
	set retcode "no_server"
    } else {
###	puts "webpatch: httpvar is $httpvar"    	
	#-- Parse the http response string
	upvar #0 $httpvar httpstate

	#-- Parse the "meta" array, if it exists
	if { [info exists httpstate(meta)] } {
	    array set httpmeta $httpstate(meta)
	} else {
	    set httpmeta(null) ""
	}

	if {[info exists httpstate(http)]} {
	    regexp -- {^([^\s]+)\s([^\s]+)\s(.*)$} $httpstate(http) \
		    match httpversion httpcode status
	    if {[info exists httpcode]} {
###		puts "httpcode is $httpcode"
		if {$httpcode == "200"} {
		    set retcode "OK"
		} elseif { [string match "3*" $httpcode] && \
			       [info exists httpmeta(Location)] } {
		    #-- http redirection!
		    set url $httpmeta(Location)
		    unset $httpvar
		    continue
		} else {
		    set retcode "no_file"
		}
	    } else {
		set retcode "no_connect"
	    }
	} else {
	    set retcode "no_connect"
	}
    }

    break
    }
    #-- End while-loop to handle http redirection

    ;##- Figure out the name of the patch file on disk
    if { [info exists ::env(HOME)] } {
	set patchfile [file join $::env(HOME) .guild${::guildVersion}_patches]
    } else {
	set patchfile ""
    }
    
    #-- Handle errors
    switch -- $retcode {
	"no_server" -
	"no_connect" {

	    ;##- See if the patch file is available on disk
	    if { [file readable $patchfile] } {

		catch {
		    set fhandle [open $patchfile r]
		    UpdateStatus \
			    "Web site unavailable; using local patch file"
		    bell
		    after 2000
		    UpdateStatus
		    eval [read $fhandle]
		    close $fhandle
		    UpdateStatus
		    set retcode "locally_patched"
		}

	    } else {

		UpdateStatus "Unable to check web site for patches!"
		bell
		after 500
		bell
		after 500
		bell
		set ::guildPatchVersion $::guildVersion
		after 3000 "UpdateStatus\
			\"Running base code (version $::guildVersion)!\";\
			after 3000 UpdateStatus"

	    }

	}

	"no_file" {
	    UpdateStatus "Web site has no patch file for this version!"
	    bell
	    set ::guildPatchVersion $::guildVersion
	    after 3000 "UpdateStatus\
		    \"Running base code (version $::guildVersion)\";\
		    after 3000 UpdateStatus"
	}

	"OK" {
	    eval $httpstate(body)
	    UpdateStatus

	    ;##- Save patch file on disk for possible future use
	    if { ! [string equal $patchfile ""] } {
		catch {
		    set fhandle [open $patchfile w]
		    puts $fhandle $httpstate(body)
		    close $fhandle
		}
	    }
	}

    }
    catch { http::cleanup $httpvar }

    set ::guildPatchStatus $retcode

    return $retcode
}


##=========================================================================
## Name: GuildStartup
##
## Description:
##   Called by GuildMain to do rest of startup stuff.
##
## Usage:
##   GuildStartup
##
## Comments:
##   This routine may be web-patched.  That's why it is important that
##   this stuff be in a routine separate from GuildMain.

proc GuildStartup {} {

    ;##- Execute any needed workarounds to startup stuff, i.e. things
    ;##- that couldn't be web-patched because they normally should
    ;##- happen before WebPatchCheck is called.
    WebPatchWorkarounds

    ;##- Record the total number of informational messages
    set ::totalInfoMessages [InfoMessages count]

    ;##- Read the current .guildrc file
    ReadGuildRc

    ;##- Set up window bindings for main window
    NewToplevel .

    ;##- Create bitmap images for icons
    CreateImages

    if {$::winIcons} {
	;##- Set up the icon for the main guild window
	NewToplevel .mainIcon -icon -width 48 -height 48 -highlightthickness 0
	label .mainIcon.bitmap -image guildIcon
	pack .mainIcon.bitmap -side top -fill x
	wm iconwindow . .mainIcon
    }

    ;##- Set up stuff to connect to DB2
    Db2Setup

    ;##- Create the menubar for the main window
    MakeMenu

    ;##- Create pulldown menus (must come after Db2Setup)
    MakeMainPulldowns

    ;##- Create the buttons in the button area
    MakeMainButtons .barea

    ;##- Add a "Quit" button
    button .barea.quit -text "Quit" -font normhelv -command {exit}
    pack .barea.quit

    ;##- Set up a button to raise all guild windows
    button .raiseall -text "raise all" -font normhelv -padx 0 -pady 0 \
	    -command {
	foreach tempwin $::windowStack {
	    if { [winfo exists $tempwin] } {
		switch -- [wm state $tempwin] {
		    normal { raise $tempwin }
		}
	    }
	}
	focus [lindex $::windowStack end]

	if { [info exists ::errorWindow] } {
	    switch -- [wm state $::errorWindow] {
		normal { raise $::errorWindow; focus $::errorWindow }
		withdrawn -
		iconic { wm deiconify $::errorWindow; focus $::errorWindow }
	    }
	}
    }
    place .raiseall -in .statuspad -relx 1 -rely 1 -anchor se

    ;##- Display any new informational messages
    DisplayMessages

    ;##- Write out the updated .guildrc file
    WriteGuildRc

    ;##- Try to get our LDAS username out of the ~/.ldaspw file
    GetLdaspwUser
    catch { register $::dbuser }

    #-- Open and display any files which were passed on the command line
    if { [info exists ::showfiles] } {
	foreach file $::showfiles {
	    DisplayFile $file scrolledtable -nodelete true
	}
    }
    
	;## time out this job if not heard from manager for 2 min
	set  ::MANAGER_REPLY_TIMEOUT 120000
    
    
    ;## place timeout on job reply from manager if set by user
	if	{ [ info exist ::env(MANAGER_REPLY_TIMEOUT) ] } {
		set  ::MANAGER_REPLY_TIMEOUT [ set ::env(MANAGER_REPLY_TIMEOUT) ]
	}
    return
}

##=========================================================================
## Name: WebPatchWorkarounds
##
## Description:
##   Routine to execute various workarounds for things which were not
##   cleanly updated by web-patching.
##
## Usage:
##   WebPatchWorkarounds
##
## Comments:
##   This is the first thing called by GuildStartup after web-patching
##   has been done.

proc WebPatchWorkarounds {} {

    return
}


##=========================================================================
## Name: ReadGuildRc
##
## Description:
##   Routine to read contents of $HOME/.guildrc into global variables
##
## Usage:
##   ReadGuildRc
##
## Comments:
##   Called by GuildMain.

proc ReadGuildRc {} {

    ;##- Figure out the full path to the .guildrc file and try to read it
    if { ! [info exists ::env(HOME)] } {
	set ::rcFileState "no_home"
	return
    }

    set ::rcFile [file join $::env(HOME) .guildrc]

    if { ! [file exists $::rcFile] } {
	set ::rcFileState "new"
	;##- Set initial values in the guildrc array
	array set ::guildrc [list \
		lastBaseVersion $::guildVersion \
		lastPatchVersion $::guildPatchVersion \
		lastMsgRead $::totalInfoMessages \
		]

	;##- Do not create the .guildrc file if web-patching failed
	if { $::guildPatchStatus != "OK" } { return }

	;##- Create the .guildrc file
	if { ! [catch {open $::rcFile w} fhandle] } {
	    foreach {index value} [array get ::guildrc] {
		puts $fhandle "$index $value"
	    }
	    catch {close $fhandle}
	}
	return
    }

    set readerror 0
    if { ! [file readable $::rcFile] } {
	set readerror 1
    } elseif { [catch {open $::rcFile r} fhandle] } {
	set readerror 1
    }

    if { $readerror == 1 } {
	set ignore [ tk_messageBox -type ok -icon warning \
		-title "Cannot read your .guildrc file" \
		-message "WARNING: guild cannot read the .guildrc file in\
		your home directory.  Therefore, you will not receive\
		informational messages about new versions of guild, etc. \
		However, guild will function normally otherwise, including\
		automatic loading of code patches via the web." ]
	set ::rcFileState "unreadable"
	return
    }

    set ::rcFileState "ok"

    ;##- Now read in the file contents
    catch {array set ::guildrc [read $fhandle]}

    catch {close $fhandle}

    ;##- Make sure the .guildrc info seems OK
    if { ! [info exists ::guildrc(lastPatchVersion)] || \
	    ! [info exists ::guildrc(lastMsgRead)] } {
	set ignore [ tk_messageBox -type ok -icon warning \
		-title "Your .guildrc file was corrupted" \
		-message "WARNING: The .guildrc file in your home directory\
		seems to have been corrupted and is being rebuilt.  You will\
		be shown several informational messages, some or all of which\
		you may have seen before, and all of your personal settings\
		will revert to the defaults.  After that, guild should work\
		normally." ]
	array set ::guildrc [list \
		lastBaseVersion 0.0 \
		lastPatchVersion 0.0 \
		lastMsgRead 0 \
		]
	WriteGuildRc force
    }

    return
}

##=========================================================================
## Name: CreateImages
##
## Description:
##   Creates bitmap images
##
## Parameters:
##   none
##
## Usage:
##   CreateImages
##
## Comments:
##   Used to make bitmaps for icons.

proc CreateImages {} {

    image create bitmap guildIcon -data [Iconbmp_guild] \
	    -foreground black -background $::bgColor
    image create bitmap buildqueryIcon -data [Iconbmp_buildquery] \
	    -foreground black -background $::bgColor
    image create bitmap sqlIcon -data [Iconbmp_sql] \
	    -foreground black -background $::bgColor
    image create bitmap ldascmdIcon -data [Iconbmp_ldascmd] \
	    -foreground black -background $::bgColor
    image create bitmap listIcon -data [Iconbmp_list] \
	    -foreground black -background $::bgColor
    image create bitmap jobIcon -data [Iconbmp_job] \
	    -foreground black -background $::bgColor
    image create bitmap jobsIcon -data [Iconbmp_jobs] \
	    -foreground black -background $::bgColor
    image create bitmap tableIcon -data [Iconbmp_table] \
	    -foreground black -background $::bgColor
    image create bitmap timeIcon -data [Iconbmp_time] \
	    -foreground black -background $::bgColor
    image create bitmap helpIcon -data [Iconbmp_help] \
	    -foreground black -background $::bgColor
    image create bitmap infoIcon -data [Iconbmp_info] \
	    -foreground black -background $::bgColor

    image create bitmap greenball -data [Htmlbmp_ball] \
	    -maskdata [Htmlbmp_ballmask] -foreground black -background green
    image create bitmap yellowball -data [Htmlbmp_ball] \
	    -maskdata [Htmlbmp_ballmask] -foreground black -background yellow
    image create bitmap orangeball -data [Htmlbmp_ball] \
	    -maskdata [Htmlbmp_ballmask] -foreground black -background orange
    image create bitmap redball -data [Htmlbmp_ball] \
	    -maskdata [Htmlbmp_ballmask] -foreground black -background red
    image create bitmap blueball -data [Htmlbmp_ball] \
	    -maskdata [Htmlbmp_ballmask] -foreground black -background blue
    image create bitmap purpleball -data [Htmlbmp_ball] \
	    -maskdata [Htmlbmp_ballmask] -foreground black -background purple
    image create bitmap envelope -data [Htmlbmp_envelope] \
	    -maskdata [Htmlbmp_envelopemask] \
	    -foreground black -background white
    image create bitmap telephone -data [Htmlbmp_telephone] \
	    -maskdata [Htmlbmp_telephonemask] -foreground black -background red

    return
}


##=========================================================================
## Name: Db2Setup
##
## Description:
##   Routine to set up things necessary to communicate with the database.
##
## Usage:
##   Db2Setup
##
## Comments:
##   Called by GuildMain.
##   Sets up the list of database servers, with their IP addresses and port
##   numbers; this is a prime candidate for web-patching if a new database
##   server is set up, etc.

proc Db2Setup {} {

    ;##- Specify IP addresses and port numbers for each database installation
    global dbservers manager_ip manager_op dbname dbinst dbreturnformat \
	    dbtempfile frame_prefix dbinst_list manager_globus_op
    set dbservers [list CIT MIT LHO LLO Test Dev Other]

    array set ::manager_ip [list \
	    CIT ldas-cit.ligo.caltech.edu \
	    MIT ldas.mit.edu \
	    LHO ldas.ligo-wa.caltech.edu \
	    LLO ldas.ligo-la.caltech.edu \
	    Test ldas-test.ligo.caltech.edu \
	    Dev ldas-dev.ligo.caltech.edu \
	    UWM ldas.phys.uwm.edu \
	    PSU ldas-psu.aset.psu.edu \
	    PSUDEV hydra.gravity.psu.edu \
	    Other ""]

    array set ::manager_op [list \
	    CIT 10001 \
	    MIT 10001 \
	    LHO 10001 \
	    LLO 10001 \
	    Test 10001 \
	    Dev 10001 \
	    UWM 10001 \
	    PSU 10001 \
	    PSUDEV 10001 \
	    Other ""]
        
    array set ::manager_globus_op [list \
	    CIT 10031 \
	    MIT 10031 \
	    LHO 10031 \
	    LLO 10031 \
	    Test 10031 \
	    Dev 10031 \
	    UWM 10031 \
	    PSU 10031 \
	    PSUDEV 10031 \
	    Other ""]
        
    array set ::frame_prefix [ list \
	    CIT [list H L] \
	    MIT [list H L] \
            LHO H \
            LLO L \
	    Test [list H L]\
	    Dev [list H L] \
	    UWM [list H L] \
	    PSU [list H L] \
	    PSUDEV [list H L] \
	    Other [list H L] ]

    ;##- The first database instance name in each list below is guild's
    ;##-  default for that server
    array set ::dbinst_list [ list \
	    CIT [list cit_s5 cit_s4 cit_e12 cit_e11 cit_s2 cit_s3 cit_s3a cit_s1 cit_test cit_beta ldas_tst default] \
	    MIT [list mit_e11 mit_s2 mit_s3 mit_s3a mit_s1 mit_e7 mit_1 mit_beta mit_test \
	              ldas_tst default] \
	    LHO [list lho_s5 lho_s4 lho_e12 lho_e11 lho_s3 lho_s3a lho_e10 lho_s2 lho_s1 "lho_2 (E5-E8)" "lho_1 (E1-E4)" \
	              lho_beta lho_test ldas_tst default] \
	    LLO [list llo_s5 llo_s4 llo_e12 llo_e11 llo_s3 llo_s3a llo_e10 llo_s2 llo_s1 "llo_2 (E5-E8)" "llo_1 (E1-E4)" \
	              llo_beta llo_test ldas_tst default] \
	    Test [list tst_s2 tst_s1 ldas_tst default] \
	    Dev [list dev_1 ldas_tst default] \
	    UWM [list uwm_s1 uwm_s1_p uwm_s1_s uwm_s1_m uwm_s2 uwm_iul uwm_e7 uwm_e5 uwm_dev \
		     uwm_test uwm_sim uwm default] \
	    PSU [list default] \
	    PSUDEV [list default] \
	    Other [list default] ]

    ;##- Set the database
    if { [info exists ::guildrc(dbname)] } {
	set dbname $::guildrc(dbname)
    } else {
	set dbname LHO
    }

    ;##- Set the database instance
    set dbinst "default"

    ;##- Set the address of the "Other" database
    if { [info exists ::guildrc(otherdbhost)] } {
	set ::otherdbhost $::guildrc(otherdbhost)
	set ::otherdbport $::guildrc(otherdbport)
    } else {
	set ::otherdbhost ""
	set ::otherdbport ""
    }
    if { [info exists ::guildrc(otherdbinst)] } {
	set ::otherdbinst $::guildrc(otherdbinst)
    } else {
	set ::otherdbinst ""
    }

    ;##- Set up list of data epochs
    set s2start  729273613   ;#-- Feb 14, 2003 8:00 PST
    set s2end    734367613   ;#-- Apr 14, 2003 8:00 PDT
    set e10start 750474013   ;#-- Oct 17, 2003 18:00 PDT
    set e10end   751028413   ;#-- Oct 24, 2003 4:00 PDT
    set s3start  751651213   ;#-- Oct 31, 2003 8:00 PST
    set s3end    757353613   ;#-- Jan 5, 2004 8:00 PST
    set ::dataEpochs [list \
	    [list {All times} 0 0 {} ] \
	    [list {Before S2} 0 $s2start {Before Feb 14, 2003, 8am PST} ] \
	    [list {During S2} $s2start $s2end {Feb 14-Apr 14, 2003} ] \
	    [list {S2 playground} template \
	         "COLNAME between $s2start and $s2end and mod(COLNAME-$s2start,6370) < 600" {} ] \
	    [list {Between S2 and E10} $s2end $e10start {Apr 14-Oct 17, 2003} ] \
	    [list {E10} $e10start $e10end {Oct 17-24, 2003} ] \
	    [list {S3} $s3start $s3end {Oct 31 2003-Jan 5 2004} ] \
	    [list {S3 playground} template \
	         "COLNAME between $s3start and $s3end and mod(COLNAME-$s2start,6370) < 600" {} ] \
	]

    ;##- Digest list of data epochs, constructing some other global lists
    set ::epochNames {}
    foreach epochlist $::dataEpochs {
	set name [lindex $epochlist 0]
	lappend ::epochNames $name
	set start [lindex $epochlist 1]
	set end [lindex $epochlist 2]
	set ::epochDescrip($name) [lindex $epochlist 3]

	if { [string equal $start "template"] } {
	    set ::epochQualCore($name) $end
	} else {
	    set startgps [HandleTimeString $start]
	    set endgps [HandleTimeString $end]

	    if { [string equal $start "0"] } {
		if { [string equal $end "0"] } {
		    set ::epochQualCore($name) ""
		} else {
		    set ::epochQualCore($name) "COLNAME < $endgps"
		}
	    } else {
		if { [string equal $end "0"] } {
		    set ::epochQualCore($name) "COLNAME >= $startgps"
		} else {
		    set ::epochQualCore($name) \
			"COLNAME between $startgps and $endgps"
		}
	    }
	}
    }

    ;##- Set the return format
    if { [info exists ::guildrc(dbreturnformat)] } {
	set dbreturnformat $::guildrc(dbreturnformat)
    } else {
	set dbreturnformat LIGO_LW
    }

    ;##- Set the value of the flag which determines whether job
    ;##- output is written to a temporary file
    if { [info exists ::guildrc(dbtempfile)] } {
	set dbtempfile $::guildrc(dbtempfile)
    } else {
	set dbtempfile no
    }
    return
}


##=========================================================================
## Name: MakeMenu
##
## Description:
##   Routine to create the menu-bar in the main window.
## 
## Usage:
##   MakeMenu
##
## Comments:
##   Called by GuildMain.
##   Does not contain any table-specific code.

proc MakeMenu {} {

    menu .menubar

    ;##- File menu
    set m File
    set $m [menu .menubar.m$m -tearoff 0]
    .menubar add cascade -label $m -menu .menubar.m$m

    ;##- Add items to File menu
    $File add command -label "Open File" -command {
	set tempFile [tk_getOpenFile -title "Select file to open"]
	set dispTl [DisplayFile $tempFile scrolledtable -nodelete true]
	unset tempFile dispTl
    }

    $File add command -label "Open URL" -command {
	set tempUrl [GetUrlToOpen]
	set dispTl [DisplayFile $tempUrl scrolledtable -nodelete true]
	unset tempUrl dispTl
    }

    $File add command -label "Change Directory" -command {
	set _tempdir [tk_chooseDirectory -mustexist 1]
	if [file isdirectory $_tempdir] { cd $_tempdir }
	unset _tempdir
    }

    $File add command -label "Save Settings" -command {
	set ::guildrc(dbname) $::dbname
	set ::guildrc(otherdbhost) $::otherdbhost
	set ::guildrc(otherdbport) $::otherdbport
	set ::guildrc(otherdbinst) $::otherdbinst
	set ::guildrc(dbreturnformat) $::dbreturnformat
	set ::guildrc(dbtempfile) $::dbtempfile
	set ::guildrc(tabledisptype) $::tabledisptype
	set ::guildrc(fontsize) $::fontsize
	set ::guildrc(usepersistent) $::usepersistent
	set ::guildrc(useproxy) $::useproxy
	WriteGuildRc force
    }

    $File add command -label "Clear Saved Settings" -command {
	foreach var [array names ::guildrc] {
	    if { ! [regexp {^last(BaseVersion|PatchVersion|MsgRead)$} $var] } {
		unset ::guildrc($var)
	    }
	}
	WriteGuildRc force
    }

    $File add command -label Quit -command {exit}

    ;##- Connect menu
    set m Connect
    set $m [menu .menubar.m$m -tearoff 0]
    .menubar add cascade -label $m -menu .menubar.m$m

    ;##- Add items to Connect menu

    ;##$Connect add command -label "Set LDAS username/password" \
	;##    -command { GetDbUser }
    
##    $Connect add cascade -label "select LDAS connection type" \
##	-menu $Connect.ldaschannel 
##    set m2 [menu $Connect.ldaschannel -tearoff 0] 
##    $m2 add radio -label "Set LDAS username/password" \
##	-variable USE_GLOBUS_CHANNEL -value 0 -command { GetDbUser }
##    $m2 add radio -label "Use X509 Proxy" -variable USE_GLOBUS_CHANNEL -value 1
##    
##    if { ! $::LOCATED_GLOBUS || !$::LOCATED_TCLGLOBUS } {
##    	set index [ $m2 index "Use X509 Proxy" ]
##    	$m2 entryconfigure $index -state disabled
##    }
 
    $Connect add command -label "Set/show \"Other\" database server" \
	    -command { GetOtherDb }

    $Connect add cascade -label "Use persistent connections?" \
	    -menu $Connect.usepersistent
    ;##- Choices under the "Use persistent connections?" menu
    set m2 [menu $Connect.usepersistent -tearoff 0]
    $m2 add radio -variable usepersistent -label "Yes, if available" -value yes \
    	-command "SetPersistent yes"
    $m2 add radio -variable usepersistent -label No -value no -command "SetPersistent no"

    if [info exists ::guildrc(usepersistent)] {
	set ::usepersistent $::guildrc(usepersistent)
    } elseif { [info exists ::env(LJPERSISTENT)] && \
		   [string equal -nocase $::env(LJPERSISTENT) "never"] } {
	set ::usepersistent no
    } else {
	set ::usepersistent yes
    }

    $Connect add cascade -label "Use proxy server?" \
	    -menu $Connect.useproxy
    ;##- Choices under the "Use proxy server?" menu
    set m2 [menu $Connect.useproxy -tearoff 0]
    $m2 add radio -variable useproxy -label Yes -value yes
    $m2 add radio -variable useproxy -label "No, unless known to be necessary" -value no

    if [info exists ::guildrc(useproxy)] {
	set ::useproxy $::guildrc(useproxy)
    } elseif [info exists ::env(LJPROXY)] {
	set ::useproxy yes
    } else {
	set ::useproxy no
    }

    $Connect add cascade -label "Metadata return format" \
	    -menu $Connect.setformat
    ;##- Choices under the "Metadata return format" menu
    set m2 [menu $Connect.setformat -tearoff 0]
    $m2 add radio -variable dbreturnformat -label LIGO_LW -value LIGO_LW
    $m2 add radio -variable dbreturnformat -label "ilwd ascii" \
	    -value "{ilwd ascii}"

    $Connect add cascade -label "Write results to temp file?" \
	    -menu $Connect.tempfile
    ;##- Choices under the "Write results to temp file" menu
    set m2 [menu $Connect.tempfile -tearoff 0]
    $m2 add radio -variable dbtempfile -label Yes -value yes
    $m2 add radio -variable dbtempfile -label No -value no


    ;##- Display menu
    set m Display
    set $m [menu .menubar.m$m -tearoff 0]
    .menubar add cascade -label $m -menu .menubar.m$m

    ;##- Add items to Display menu

    $Display add radio -variable tabledisptype \
	    -label "Display query results as table" -value "scrolledtable"
    $Display add radio -variable tabledisptype \
	    -label "Don't display; just write to file" -value "file"

    ;##- Set tabledisptype variable to initial value
    if { [info exists ::guildrc(tabledisptype)] } {
	set ::tabledisptype $::guildrc(tabledisptype)
    } else {
	set ::tabledisptype "scrolledtable"
    }

    $Display add separator

    $Display add cascade -label "Font size..." -menu $Display.fontsize
    ;##- Choices under the "Font size" menu
    set m2 [menu $Display.fontsize -tearoff 0]
    $m2 add radio -variable fontsize -label 8 -value 8 \
	    -command {SetFontSize 8}
    $m2 add radio -variable fontsize -label 9 -value 9 \
	    -command {SetFontSize 9}
    $m2 add radio -variable fontsize -label 10 -value 10 \
	    -command {SetFontSize 10}
    $m2 add radio -variable fontsize -label 12 -value 12 \
	    -command {SetFontSize 12}
    $m2 add radio -variable fontsize -label 14 -value 14 \
	    -command {SetFontSize 14}
    $m2 add radio -variable fontsize -label 18 -value 18 \
	    -command {SetFontSize 18}
    $m2 add radio -variable fontsize -label 24 -value 24 \
	    -command {SetFontSize 24}

    $Display add cascade -label "Raise/deiconify window..." \
	    -menu $Display.window

    menu $Display.window -tearoff 0 -postcommand [ selsub {
	$Display.window delete 0 end
	foreach tempwin [lsort $::windowStack] {
	    if { [winfo exists $tempwin] } {
		$Display.window add command -label [wm title $tempwin] \
			-command [ selsub {
		    if { [winfo exists $tempwin] } {
			switch -- [wm state $tempwin] {
			    normal { raise $tempwin; focus $tempwin }
			    withdrawn -
			    iconic { wm deiconify $tempwin; focus $tempwin }
			}
		    }
		} tempwin ]
	    }
	}
    } Display ]    

    ;##- Set fontsize variable to initial value
    if { [info exists ::guildrc(fontsize)] } {
	set ::fontsize $::guildrc(fontsize)
    } else {
	set ::fontsize 12
    }

    ;##- If necessary, update the font size on the screen
    if { $::fontsize != [font configure normfont -size] } {
	SetFontSize $::fontsize
    }


    ;##- Help menu (note special Tk widget pathname, which causes the Help
    ;##- menu to appear at the right edge of the menu bar)
    set m Help
    set $m [menu .menubar.help -tearoff 0]
    .menubar add cascade -label $m -menu .menubar.help
    ;##- Add items to help menu
    $Help add command -label "Version information" -command ShowVersion
    $Help add command -label "General information" -command ShowGeneralHelp
    $Help add command -label "Revision history" -command "DisplayMessages all"

    ;##- Finally, attach the menu bar to the main window (.)
    . config -menu .menubar

    return
}

##=========================================================================
## Name: GetUrlToOpen
##
## Description:
##   Routine to pop up a window and let the user enter a URL to be
##   parsed and displayed.
##
## Usage:
##   GetUrlToOpen
##
## Comments:
##   Called from the "Connect" menu.
##   Returns the URL to open, or "" if the user cancels.

proc GetUrlToOpen {} {

    ;##- Create a new window for input
    set tl .geturltoopen
    if {[winfo exists $tl]} {
	switch -- [wm state $tl] {
	    normal { raise $tl; focus $tl }
	    iconic { wm deiconify $tl; focus $tl }
	}
	return ""
    } else {
	NewToplevel $tl
	wm title $tl "Enter URL to open"
    }

    ;##- Set up widgets
    frame $tl.url
    label $tl.url.label -text "URL:"
    entry $tl.url.entry -width 80

    ;##- Insert a default URL (same as last time, if there was a last time)
    if { ! [info exists ::urlToGet] } {
	set ::urlToGet ""
    }
    $tl.url.entry insert end $::urlToGet

    frame $tl.barea
    button $tl.barea.ok -text "OK" -default active \
	    -command "set tempUrlToGet \[$tl.url.entry get\]; destroy $tl"
    button $tl.barea.clear -text "Clear" \
	    -command "$tl.url.entry delete 0 end"
    button $tl.barea.cancel -text Cancel \
	    -command "set tempUrlToGet {}; destroy $tl"

    ;##- Bind the return key for convenience
    bind $tl <Return> "$tl.barea.ok invoke"

    ;##- Lay out the widgets
    grid $tl.url.label $tl.url.entry -sticky news
    grid columnconfigure $tl.url 1 -weight 1
    grid $tl.barea.ok $tl.barea.clear $tl.barea.cancel
    grid $tl.url -sticky news
    grid $tl.barea -sticky ns

    ;##- Set focus to the entry widget
    focus $tl.url.entry

###    ;##- Grab the focus
###    set oldfocus [focus]
###    focus $tl
###    update idletasks
###    catch {tkwait visibility $tl}
###    catch {grab $tl}

    ;##- Wait for the window to be destroyed
    tkwait window $tl

###    ;##- Release the focus
###    catch {grab release $tl}
###    focus $oldfocus

    if { ! [string is space $::tempUrlToGet] } {
	regsub -all {\s} $::tempUrlToGet {} ::urlToGet
	
	;##- Add "http://" at the beginning if not already there
	if { ! [regexp -- {^http://} $::urlToGet] } {
	    set ::urlToGet "http://$::urlToGet"
	}
	return $::urlToGet
    } else {
	return ""
    }
}

##=========================================================================
## Name: SetFontSize
##
## Description:
##   Routine to change the font size for all guild windows.
##
## Usage:
##   SetFontSize size
##
## Parameters:
##   size -- Size in points
##
## Comments:
##   Changes the global named fonts (normfont, etc.); also has to
##   recalculate tab stops and margins for text widgets, and recreate
##   the bitmaps in the colheads area of scrolledtables..

proc SetFontSize { size } {

    ;##- Record current character width
    if {[info exists scrolledtable::charwidth]} {
	set oldwidth $scrolledtable::charwidth
    } else {
	set oldwidth [font measure normfont X]
    }
###    puts "Old width is $oldwidth"

    ;##- Reconfigure fonts
    font configure normfont -size $size
    font configure boldfont -size $size
    font configure normhelv -size $size
    font configure bighelv -size [expr {3*$size}]

    ;##- Reset character width/height variables
    set newwidth [font measure "courier $size" X]
    if {[info exists scrolledtable::charwidth]} {
	set scrolledtable::charwidth $newwidth
	set scrolledtable::charheight [font metrics "courier $size" -linespace]
    }
###    puts "New width is $newwidth"

    ;##- Construct list of all text widgets
    set wlist {.}
    set textlist {}
    set canvaslist {}
    set windex 0
    while {$windex < [llength $wlist]} {
	set w [lindex $wlist $windex]
	if { [winfo class $w] == "Text" } {
	    lappend textlist $w
	}
	if { [regexp {^\.tl.*\.quals\.canvas\.f$} $w] } {
	    lappend canvaslist [winfo parent $w]
	}
	set wlist [concat $wlist [winfo children $w]]
	incr windex
    }
###    puts "List of text widgets is $textlist"
###    puts "List of canvas widgets is $canvaslist"

    ;##- Now check each text widget for tab settings,
    ;##- or with tags with margin attributes
    foreach w $textlist {
###	puts "$w:"

	set oldtabs [$w cget -tabs]
	if {! [string is space $oldtabs]} {
	    set newtabs {}
	    foreach oldval $oldtabs {
		if { [regexp {^[0-9]$} $oldval number] } {
		    lappend newtabs [expr {round($number*$newwidth/$oldwidth)}]
		} elseif { [regexp {^([0-9.]+)(\w*)$} $oldval\
			match number string] } {
		    lappend newtabs [expr {$number*$newwidth/$oldwidth}]$string
		} else {
		    lappend newtabs $oldval
		}
	    }
	    $w configure -tabs $newtabs
###	    puts "$w: changed tabs from  $oldtabs  to  $newtabs"
	}

	foreach tag [$w tag names] {
###	    puts "  tag $tag:"
	    foreach attrib {lmargin1 lmargin2 rmargin} {
		set oldval [$w tag cget $tag -$attrib]
		if {! [string is space $oldval]} {
		    if { [regexp {^[0-9]$} $oldval number] } {
			set newval [expr {round($number*$newwidth/$oldwidth)}]
		    } elseif { [regexp {^([0-9.]+)(\w*)$} $oldval\
			    match number string] } {
			set newval [expr {$number*$newwidth/$oldwidth}]$string
		    } else {
			set newval $oldval
		    }
		    $w tag configure $tag -$attrib $newval
###		    puts "    $w tag $tag:\
###			    changed $attrib from  $oldval  to  $newval"
		}
	    }

	    set oldtabs [$w tag cget $tag -tabs]
	    if {! [string is space $oldtabs]} {
		set newtabs {}
		foreach oldval $oldtabs {
		    if { [regexp {^[0-9]$} $oldval number] } {
			lappend newtabs \
				[expr {round($number*$newwidth/$oldwidth)}]
		    } elseif { [regexp {^([0-9.]+)(\w*)$} $oldval\
			    match number string] } {
			lappend newtabs \
				[expr {$number*$newwidth/$oldwidth}]$string
		    } else {
			lappend newtabs $oldval
		    }
		}
		$w tag configure $tag -tabs $newtabs
###		puts "$w tag $tag: changed tabs from  $oldtabs  to  $newtabs"
	    }

	}

    }

    ;##- Recreate bitmaps in colheads area of scrolledtable widgets, but only
    ;##- if they already exist (indicated by scrolledtable::charwidth existing)
    if {[info exists scrolledtable::charwidth]} {
	image delete leftbar
	image delete leftbarplus
	image delete rightbar
	image delete bothbar
	scrolledtable::MakeBitmaps normfont
    }

    ;##- Need to do this for the winfo calls below to be accurate
    update idletasks

    ;##- Fix scollregions of qualifier areas in build-query dialogs
    foreach w $canvaslist {
	if { [winfo exists $w.f] } {
	    if { [winfo class $w.f] == "Frame" && \
		    ! [string is space [$w cget -scrollregion]] } {
		set width [winfo reqwidth $w.f]
		set height [winfo reqheight $w.f]
		$w config -scrollregion "0 0 $width $height"
	    }
	}
    }

    return
}


##=========================================================================
## Name: MakeMainPulldowns
##
## Description:
##   Main routine to create the pulldown menus in the guild main window.
## 
## Parameters:
##   none
##
## Usage:
##   MakePulldowns
##
## Comments:
##   Currently there is only one pulldown, to set the database server.

proc MakeMainPulldowns {} {

    ;##- Pulldown menu to select database server
    frame .pulls.server
    label .pulls.server.text -text "Current LDAS server:" -font normhelv
    set menu [eval tk_optionMenu .pulls.server.menu dbname $::dbservers]

    ;##- Register a command for the "Other" menu choice
    set index [lsearch -exact $::dbservers "Other"]
    $menu entryconfig $index -command \
	    {if { [string is space $::otherdbhost] } { GetOtherDb } }

    .pulls.server.menu config -pady 0
    pack .pulls.server.text -side left
    pack .pulls.server.menu -side left


    ;##- Pulldown menu to select access method
    frame .pulls.access
    label .pulls.access.text -text "Access by:" -font normhelv
    set menu [eval tk_optionMenu .pulls.access.menu ACCESS_METHOD \
		  [list "LDAS username" "X509 proxy"] ]

    if { ! $::LOCATED_TCLGLOBUS } {
    	$menu entryconfigure 1 -state disabled
    }

    .pulls.access.menu config -pady 0
    pack .pulls.access.text -side left
    pack .pulls.access.menu -side left


    ;##- Pulldown menu to select database instance
    frame .pulls.inst
    label .pulls.inst.text -text "Database name:" -font normhelv
    set menu [tk_optionMenu .pulls.inst.menu dbinst "default"]
    ;##- Fill in the menu entries
    UpdateInstMenu

    .pulls.inst.menu config -pady 0
    pack .pulls.inst.text -side left
    pack .pulls.inst.menu -side left

    ;##- Set up a trace to update the instance menu whenever ::dbname changes
    trace variable ::dbname w UpdateInstMenu


    pack .pulls.server -side top -anchor n
    pack .pulls.access -side top -anchor n
    pack .pulls.inst -side top -anchor n

    return
}

##=========================================================================
## Name: UpdateInstMenu
##
## Description:
##   Routine to update the entries in the pulldown menu of DB instances.
##   Called when the user updates the LDAS server to connect to.
## 
## Parameters:
##   None
##
## Usage:
##   trace variable ::dbname w UpdateInstMenu
##
## Comments:

proc UpdateInstMenu { args } {

    ;##- Delete the current menu entries
    .pulls.inst.menu.menu delete 0 end

    ;##- Rebuild the list of menu entries
    foreach item $::dbinst_list($::dbname) {
	.pulls.inst.menu.menu add radio -label $item \
		-variable dbinst -value [lindex $item 0] \
		-command "set ::dbinstSave($::dbname) [lindex $item 0]"
    }

    ;##- If a specific database was selected previously, use it again
    if { [info exists ::dbinstSave($::dbname)] } {
	set ::dbinst $::dbinstSave($::dbname)
    } else {
	set ::dbinst [lindex [lindex $::dbinst_list($::dbname) 0] 0]
    }

    return
}


##=========================================================================
## Name: MakeMainButtons
##
## Description:
##   Main routine to create the buttons/menubuttons in the guild main window
##   to initiate various types of queries or bring up "build query" dialogs
##   for various database tables.
## 
## Parameters:
##   w -- parent frame in which to create the buttons
##
## Usage:
##   MakeMainButtons w
##
## Comments:
##   Contains much table-specific code.  To keep this routine readable,
##   it creates most of the buttons via calls to the simple routines
##   MainMenubutton and AddBuildQueryDialog.

proc MakeMainButtons { w } {

    set mb [MainMenubutton $w metadata "LDAS metadata database..."]

    $mb add command -label "List all database tables" \
	    -command { Db2Submit \
	    "SELECT tabname, tabschema, definer, create_time,\
	    colcount, remarks\
	    FROM syscat.tables WHERE tabschema='LDASDB'\
	    ORDER BY tabschema, tabname" scrolledtable\
	    -description "List of database tables"}

    $mb add cascade -label "LDAS job info..." \
	    -menu $mb.ldasjobs
    set m [menu $mb.ldasjobs -tearoff 0 -font normhelv]
    $m add command -label "List LDAS job IDs" \
	    -command { Db2Submit \
	    "SELECT jobid,start_time,end_time,process_id,creator_db\
	    FROM process ORDER BY start_time"\
	    scrolledtable -description "List of LDAS jobs"}
    $m add command -label "List user tags for LDAS jobs" \
	    -command { Db2Submit \
	    "SELECT DISTINCT substr(value,1,64) as USER_TAG\
	    FROM process_params\
	    WHERE param='-userTag' AND value<>'' ORDER BY substr(value,1,64)"\
	    scrolledtable -description "List of user tags for LDAS jobs"}
    AddBuildQueryDialog $m search_summary    "- Search summary info"
    AddBuildQueryDialog $m search_summvars   "- Search summary variables"

    $mb add cascade -label "Process/filter info..." \
	    -menu $mb.process_info
    set m [menu $mb.process_info -tearoff 0 -font normhelv]
    AddBuildQueryDialog $m process           "- Processes"
    AddBuildQueryDialog $m process_params    "- Process params"
    AddBuildQueryDialog $m filter            "- Filters"
    AddBuildQueryDialog $m filter_params     "- Filter params"

    $mb add cascade -label "Frameset info..." \
	    -menu $mb.frameset_info
    set m [menu $mb.frameset_info -tearoff 0 -font normhelv]
    AddBuildQueryDialog $m frameset_writer   "- Writer processes"
    AddBuildQueryDialog $m frameset_chanlist "- Channel lists"
    AddBuildQueryDialog $m frameset          "- Framesets"
    AddBuildQueryDialog $m frameset_loc      "- Frameset locations"

    $mb add cascade -label "Segment info..." \
	    -menu $mb.segment_info
    set m [menu $mb.segment_info -tearoff 0 -font normhelv]
#-- The segment_definer table is not currently used
##    AddBuildQueryDialog $m segment_definer   "- Definer processes"
    AddBuildQueryDialog $m segment           "- Segments"

    $mb add cascade -label "Summary info..." \
	    -menu $mb.summary_info
    set m [menu $mb.summary_info -tearoff 0 -font normhelv]
    AddBuildQueryDialog $m summ_value        "- Scalar values"
    AddBuildQueryDialog $m summ_statistics   "- Standard statistics"
    AddBuildQueryDialog $m summ_spectrum     "- Spectra"
    AddBuildQueryDialog $m summ_csd          "- CSD arrays"
    AddBuildQueryDialog $m summ_mime         "- MIME objects"
    AddBuildQueryDialog $m summ_comment      "- Comments"

    $mb add command -label "GDS triggers" \
	    -command { BuildQueryDialog gds_trigger }

    $mb add cascade -label "Single-ifo events..." \
	    -menu $mb.sngl_info
    set m [menu $mb.sngl_info -tearoff 0 -font normhelv]
    AddBuildQueryDialog $m sngl_inspiral     "- Inspiral candidates"
    AddBuildQueryDialog $m sngl_burst        "- Burst candidates"
    AddBuildQueryDialog $m waveburst         "- WaveBurst triggers"
    AddBuildQueryDialog $m sngl_block        "- BlockNormal candidates"
    AddBuildQueryDialog $m sngl_ringdown     "- Ringdown candidates"
    AddBuildQueryDialog $m sngl_unmodeled    "- Unmodeled candidates"
    AddBuildQueryDialog $m sngl_dperiodic    "- Directed periodic searches"
    AddBuildQueryDialog $m sngl_datasource   "- Datasource records"
    AddBuildQueryDialog $m sngl_transdata    "- Transformed-data records"
    AddBuildQueryDialog $m sngl_mime         "- MIME records"
    AddBuildQueryDialog $m coinc_sngl        "- Coincidences"

    $mb add cascade -label "Multi-ifo events..." \
	    -menu $mb.multi_info
    set m [menu $mb.multi_info -tearoff 0 -font normhelv]
    AddBuildQueryDialog $m multi_inspiral    "- Inspiral candidates"
    AddBuildQueryDialog $m multi_burst       "- Burst candidates"

    $mb add cascade -label "External-trigger tables..." \
	    -menu $mb.exttrig_info
    set m [menu $mb.exttrig_info -tearoff 0 -font normhelv]
    AddBuildQueryDialog $m external_trigger  "- External trigger reports"
    AddBuildQueryDialog $m exttrig_search    "- Externally-triggered searches"

    $mb add cascade -label "Other tables..." \
	    -menu $mb.other_info
    set m [menu $mb.other_info -tearoff 0 -font normhelv]
    AddBuildQueryDialog $m calib_info        "- Calibration info"

    $mb add command -label "Arbitrary database query" \
	    -command { GetArbitrarySQL }

    ;##--------

    set mb [MainMenubutton $w framedata "Frame data..."]

    $mb add command -label "Get frame data from LDAS" \
	    -command { BuildDataQueryDialog }

    ;##--------

    button $w.mreq -text "LDAS user command" -font normhelv -pady 0 \
	    -command LDASUserCommand
    pack $w.mreq -fill x -pady 1

    ;##--------

    set mb [MainMenubutton $w utilities "Utilities..."]

    $mb add command -label "Time converter" \
	    -command { TimeConverter }
    $mb add command -label "Watch jobs at current LDAS server" \
	    -command { WatchJobs }
    $mb add command -label "Get log entries for LDAS job" \
	    -command { GetLogEntries }

    return
}

##========================
## Name: MainMenubutton
##
## Description:
##   Simple convenience routine to create a menubutton and its associated menu.
##   Returns the Tk pathname of the created menu.
##
## Parameters:
##   w -- parent frame in which to create the menubutton
##   name -- name for the menubutton (arbitrary, but must be distinct)
##   text -- text to put on the menubutton
##
## Usage:
##   MainMenubutton w name text
##
## Comments:
##   Pretty simple routine.

proc MainMenubutton { w name text } {
    menubutton $w.$name -text $text -font normhelv -pady 0 \
	    -relief raised -borderwidth 2 -pady 1 -highlightthickness 1 \
	    -indicatoron true \
	    -menu $w.$name.menu -direction below
    set m [ menu $w.$name.menu -font normhelv -tearoff 0 -borderwidth 4]
    pack $w.$name -fill x -pady 1
    return $m
}

##========================
## Name: AddBuildQueryDialog
##
## Description:
##   Simple convenience routine to add a command to a menubutton menu which
##   creates a "build query" dialog for a given table.
## 
## Parameters:
##   m -- Tk pathname of parent menu
##   table -- database table for which a "build query" dialog will be created
##   text -- text to display for the menu choice
##
## Usage:
##   AddBuildQueryDialog m table text
##
## Comments:
##   It doesn't get much simpler than this!

proc AddBuildQueryDialog { m table text } {
    $m add command -label $text -command "BuildQueryDialog $table"
    return
}

##=========================================================================
## Name: DisplayMessages
##
## Description:
##   Routine to download and display any new informational messages, e.g. a
##   notice that the user is now running a new version thanks to web-patching.
##
## Usage:
##   DisplayMessages
##   DisplayMessages all
##
## Comments:
##   Called by GuildMain just before turning things over to the user.

proc DisplayMessages { {which ""} } {

    if { $which == "all" } {
	set msg [VersionMessages 0.0]
    } else {

	if { $::rcFileState == "no_home" || $::rcFileState == "unreadable" } {
	    return
	}

	set msg ""

	if { $::rcFileState == "new" } {

	    ;##------ General welcome message

	    append msg "\nWelcome to guild!\n"

	    append msg "\nEach time you start up guild, it checks a web site\
		    for code patches (bug fixes, code to handle newly-defined\
		    database tables, new features, etc.) and informational\
		    messages.  Code patches are automatically loaded into\
		    memory for immediate use (without changing the copy of\
		    guild residing on your computer).  "
	    append msg "You will be shown a message window, like this one,\
		    at start-up time whenever a new patch version has been\
		    loaded or there is a new informational message. \
		    A file called .guildrc has been created in your\
		    home directory to keep track of what code version you\
		    have used and what messages you have seen.\n"

	    ;##
	    append msg "\nNOTE about usernames/passwords:\nTo submit any\
		    database query (or execute any other LDAS job), you will\
		    need a valid LDAS username/password combination, which\
		    guild will prompt you for.  These are specific to LDAS,\
		    i.e. NOT the same as any Unix account you have.  See\
  http://www.ldas-sw.ligo.caltech.edu/ligotools/faq/get_ldas_username.html\
                    for information about getting an LDAS username/password.\n"

	    ;##------ Specific information for first-time users
	    append msg "\nPlease feel free to report bugs and suggest\
		    improvements to Peter Shawhan\
		    (shawhan_p@ligo.caltech.edu).\n"

	}  ;##- End of block of messages for new user

	;##------------------------------------------------------------
	;##------ Information about new versions

	set oldbase $::guildrc(lastBaseVersion)
	set oldpatch $::guildrc(lastPatchVersion)
	set newbase $::guildVersion
	set newpatch $::guildPatchVersion

	if { $newpatch != "" && $oldpatch != "" } {

	    if {[CompareVersions $newpatch > $oldpatch]} {
		if { $msg != "" } { append msg "\n--------------------------" \
			"----------------------------------------------\n" }
		append msg "\nNOTICE OF NEW VERSION\n"
		append msg "\nYou are now running guild version $newpatch\n"
		if { $newpatch != $newbase } {
		    append msg "(Base version $newbase,\
			    web-patched to version $newpatch)\n"
		}
		append msg "\nPreviously, you were running version $oldpatch\n"
		if { $oldpatch != $oldbase } {
		    append msg "(Base version $oldbase,\
			    web-patched to version $oldpatch)\n"
		}

		;##- Summary of changes for new version(s)
		append msg [VersionMessages]

	    } elseif { ($newpatch == $oldpatch) } {
		if { [CompareVersions $newbase > $oldbase] } {
		    if { $msg != "" } { append msg \
			    "\n------------------------------" \
			    "------------------------------------------\n" }
		    append msg \
			    "\nYour base version of guild (the copy on disk)\
			    has changed from $oldbase to $newbase.  However,\
			    due to web-patching, both the old and new base\
			    programs effectively operate as version $newpatch,\
			    and therefore should behave identically.\n"
		} elseif { [CompareVersions $newbase < $oldbase] } {
		    if { $msg != "" } { append msg \
			    "\n------------------------------" \
			    "------------------------------------------\n" }
		    append msg "\nWARNING: Your base version of guild (the\
			    copy on disk) has changed from $oldbase to\
			    $newbase, i.e. to a LESS recent version.  However,\
			    due to web-patching, both the old and new base\
			    programs effectively operate as version $newpatch,\
			    and therefore should behave identically.\n"
		}
	    }
	}

	;##------------------------------------------------------------
	;##------ Informational messages

	set infomsgs [InfoMessages]
	if { $infomsgs != "" } {
	    if { $msg != "" } {
		append msg "\n------------------------------------" \
			"------------------------------------\n"
	    }
	    append msg $infomsgs
	}

    }

    ;##------------------------------------------------------------
    ;##------ If there were any messages, create a window to display them

    if { $msg == "" } { return }

    ;##- Create a new window
    set tl [NewToplevel]
    if { $which == "all" } {
	wm title $tl "guild Revision History"
	wm iconname $tl "Revision History"
    } else {
	wm title $tl "guild Message Window"
	wm iconname $tl "Messages"
    }

    if {$::winIcons} {
	;##- Also create an icon for this window
	NewToplevel ${tl}Icon -icon -width 48 -height 48 -highlightthickness 0
	label ${tl}Icon.bitmap -image infoIcon
	pack ${tl}Icon.bitmap -side top -fill x
	wm iconwindow $tl ${tl}Icon
    }

    ;##- Create a frame with a text widget and a scrollbar
    frame $tl.msg
    text $tl.msg.text -width 76 -height 16 -wrap word \
	    -yscrollcommand "$tl.msg.yscroll set" -setgrid true
    bind $tl.msg.text <Button> "focus %W"
    scrollbar $tl.msg.yscroll -orient vertical \
	    -command "$tl.msg.text yview"

    ;##- Insert the message into the text widget
    $tl.msg.text insert end $msg

    ;##- Disable modifications to the text widget
    $tl.msg.text config -state disabled

    ;##- Create a "Close" button
    button $tl.close -text "Close" \
	    -command "if {\[winfo exists ${tl}Icon\]} {destroy ${tl}Icon};\
	    destroy $tl" \
	    -default active

    ;##- Bind the Return key to the Close button
    bind $tl <Return> "$tl.close invoke"

    ;##- Lay out the widgets
    pack $tl.close -side bottom
    grid $tl.msg.text $tl.msg.yscroll -sticky news
    grid rowconfigure $tl.msg 0 -weight 1
    grid columnconfigure $tl.msg 0 -weight 1
    pack $tl.msg -side top -fill both -expand true

    return
}

##=========================================================================
## Name: VersionMessages
##
## Description:
##   Returns messages about new versions of guild
##
## Parameters:
##   none
##
## Usage:
##   VersionMessages
##   VersionMessages oldver
##
## Comments:
##   

proc VersionMessages { {oldver ""} } {

    if { $oldver == "" } {
	set oldver $::guildrc(lastPatchVersion)
    }

    if { $::rcFileState == "new" } {
	set show 0
    } else {
	set show 1
    }

    set msg ""

    ;##- Get older messages
    if { [CompareVersions $oldver < "3.9.1"] } {
	    append msg [VersionMessagesPre39 $oldver]
    }
    if { [CompareVersions $oldver < "3.23.0"] } {
	    append msg [VersionMessagesPre323 $oldver]
    }

    ;##------ Messages start here

    if { [CompareVersions $oldver < "3.23.0"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.23.0\n"
	append msg "\n* Rewrote code to get frame-cache information using an\
		LDAS user command rather than an http transfer.  NOTE that\
		guild no longer checks the frame cache automatically when you\
		open a raw data request window; you have to click on the\
		'Check' button.\n"
	append msg "\n* Added S2 databases to the lists of available\
		databases, and made them the default for queries at LHO and\
		LLO.  Also made mit_s1 the default for queries at MIT.\n"
	append msg "\n* Fixed help text to remove references to the\
		ldas_account email address, which is no longer the appropriate\
		way to request an LDAS username.\n"
	append msg "\n* Moved old version messages into a separate proc, to\
		reduce the amount of data transferred during web-patching.\n"
    }

    if { [CompareVersions $oldver < "3.23.1"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.23.1\n"
	append msg "\n* Fixed bug: queries from LLO were using the LDAS job\
                proxy server, even when connecting to the LLO LDAS system.\n"
    }

    if { [CompareVersions $oldver < "3.23.2"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.23.2\n"
	append msg "\n* Added data epoch categories for S2, including an\
                \"S2 playground\" category which selects events in the time\
                intervals defined by Sam Finn and Peter Saulson (600 out of\
	        every 6370 seconds, starting at 16:00 UTC on 14 Feb 2003).\n"
	append msg "\n* Updated database list for ldas-test: added database\
                tst_s2, and removed database tst_test.\n"
	append msg "\n* Handle error condition if user seems to enter a\
		resampling factor of 0 when retrieving raw data.\n"
    }

    if { [CompareVersions $oldver < "3.23.3"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.23.3\n"
	append msg "\n* Added rest of columns to build-query window for\
            WaveBurst table.\n"
	append msg "\n* Clarified some comparison variable descriptions\
            in build-query dialog windows.\n"
    }

    if { [CompareVersions $oldver < "3.23.4"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.23.4\n"
	append msg "\n* Fixed bug in frame-cache summary code which failed to\
	    recognize a gap consisting of a single file (PR 1901, reported by\
	    Igor).\n"
	append msg "\n* Added code to work around the fact that LDAS currently\
            gives an error when you submit a getFrameCache job to get the\
            channel list at the latest available time (i.e. you don't specify\
            a time in the user command).  (Problem reported by Gaby.)\n"
    }

    if { [CompareVersions $oldver < "3.23.5"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.23.5\n"
	append msg "\n* Modified cache parsing code to handle the case of\
            a given file appearing in more than one directory in the cache.\n"
	append msg "\n* Fixed bug querying correct LDAS system when user\
            clicks on the 'Recheck' button in a Build Raw Data Request\
            window.\n"
    }

    if { [CompareVersions $oldver < "3.23.6"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.23.6\n"
	append msg "\n* Added PSU and PSUDEV LDAS systems, replacing old PSU\
	    system which is no longer running at the same address.\n"
	append msg "\n* Added larger font sizes to list (under the 'Display'\
	    menu).\n"
    }

    if { [CompareVersions $oldver < "3.23.7"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.23.7\n"
	append msg "\n* Removed the warning message about version-6 frame\
            files, now that DTT version 2.2 (which can read them) is available\
            in LIGOtools.\n"
	append msg "\n* Added uwm_s1_m, uwm_s1_p, and uwm_s2 to list of\
            databases at UWM.  uwm_s1 is still the default for queries, for\
            now.\n"
	append msg "\n* Made cit_s1 the default database for queries at CIT.\n"
	append msg "\n* Change cursor to a 'watch' while parsing files, to\
	    indicate that guild is busy and will not respond to mouse clicks.\n"
    }

    if { [CompareVersions $oldver < "3.23.8"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.23.8\n"
	append msg "\n* Added cluster_id to query dialog for waveburst table,\
              and removed s_cut from query dialog.\n"
	append msg "\n* Added new table sngl_block.\n"
    }

    if { [CompareVersions $oldver < "3.24.0"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.24.0\n"
	append msg "\n* Guild now gets your LDAS username and password out of\
            your ~/.ldaspw file, if it exists, so you don't have to enter them\
            when you submit the first job.  Note that it always picks the\
            first username in the ~/.ldaspw file; if you need to use a\
            different username, you will have to set it manually (under the\
            \"Connect\" menu).\n"
	append msg "\n* Revised frame query dialog and underlying code since\
            one no longer needs to provide the \"-ifo\" argument to the\
            createRDS user command, or to related user commands.\n"
	append msg "\n* Added code to try to pick a descriptive name for\
            output frame files.  For instance, if one channel is being\
            retrieved, the output frame file name will contain the\
            interesting part of the channel name.  (Note that the current\
            version of LDAS adds a number at the end.)\n"
	append msg "\n* Revised help text about building raw data queries.\n"
	append msg "\n* Fixed code to handle the slightly different structure\
	    of the frame cache information in LDAS 0.7.\n"
	append msg "\n* Fixed bug when handling 10-digit GPS times in time\
            converter utility.\n"
    }

    if { [CompareVersions $oldver < "3.24.1"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.24.1\n"
	append msg "\n* Modified the frame data request dialog window to\
            allow the user to specify the 'type' string for output frame\
            files.\n"
	append msg "\n* Fixed bug in code which build createRDS user command\
	    when resampling is specified.\n"
    }

    if { [CompareVersions $oldver < "3.25.0"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.25.0\n"
	append msg "\n* Rewrote frame cache parsing and displaying code\
             to improve efficiency when handling very large frame caches.\n"
    }

    if { [CompareVersions $oldver < "3.25.1"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.25.1\n"
	append msg "\n* Rewrote frame cache displaying code AGAIN for another\
             performance boost; now it's very fast, even if the frame cache\
             contains tens of thousands of distinct data segments.\n"
    }

    if { [CompareVersions $oldver < "3.25.2"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.25.2\n"
	append msg "\n* Bug fix: when getting frame data and setting user type\
	    automatically, avoid ending the user type with a digit.\n"
    }

    if { [CompareVersions $oldver < "3.25.3"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.25.3\n"
	append msg "\n* Fixed bug in the output of the 'List data types'\
                function in the frame data request window.\n"
    }

    if { [CompareVersions $oldver < "3.25.4"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.25.4\n"
	append msg "\n* Fixed bug handling very long list of result files\
	        from a raw data request.\n"
    }

    if { [CompareVersions $oldver < "3.25.5"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.25.5\n"
	append msg "\n* Fixed bug reported by Natalia: another case in which\
		the frame query createRDS user type was ending with a digit.\n"
    }

    if { [CompareVersions $oldver < "3.25.6"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.25.6\n"
	append msg "\n* Added workaround for the CIT LDAS system, on which (at\
		least under LDAS 0.7.0) the diskcache API sometimes uses the\
		wrong IP address in the URL it reports back to the user.\n"
	append msg "\n* Fixed bug: when extracting channels from trend frames,\
		automatically generated frame type string contained a period,\
		which is not a valid character in this situation.\n"
    }

    if { [CompareVersions $oldver < "3.26.0"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.26.0\n"
	append msg "\n* Updated LDAS command submitted when user clicks on the\
	        'List channels' button, to work with LDAS 0.8.\n"
    }

    if { [CompareVersions $oldver < "3.26.1"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.26.1\n"
	append msg "\n* Added lho_e10 and llo_e10 databases, and made them the\
	        defaults for queries directed to LHO and LLO, respectively.\n"
	append msg "\n* Added error handling if user requests channel list\
                for an invalid data time / site combination.\n"
    }

    if { [CompareVersions $oldver < "3.27.0"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.27.0\n"
	append msg "\n* Now ignore the 'integrity' field in a frame cache,\
	        since its value is apparently arbitrary.\n"
    }

    if { [CompareVersions $oldver < "3.27.1"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.27.1\n"
	append msg "\n* Added query epochs for E10 and S3 runs.\n"
	append msg "\n* Updated frame output size estimation code to infer\
	    correct sampling rates for EXC_DAQ channels and some others.\n"
    }

    if { [CompareVersions $oldver < "3.27.2"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.27.2\n"
	append msg "\n* Added lho_s3, llo_s3, cit_s3, and mit_s3 databases. \
	    Made lho_s3 and llo_s3 the defaults for queries at LHO and LLO. \
	    Also, made cit_s2 and mit_s2 (not s3) the defaults for queries\
	    at CIT and MIT.\n"
    }

    if { [CompareVersions $oldver < "3.27.3"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.27.3\n"
	append msg "\n* Added an 'S3 playground' epoch choice for queries,\
		and made it the default when querying from the S3 databases\
		at the observatories.\n"
    }

    if { [CompareVersions $oldver < "3.28.0"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.28.0\n"
	append msg "\n* Enhanced code which lists frame cache details, so that\
                it lists substantially different directory paths separately.\n"
	append msg "\n* When submitting a frame query, user can now choose\
                whether to download output or to simply report the URL(s) for\
                separate downloading.\n"
	append msg "\n* When downloading an LDAS output file named 'daq.ilwd'\
                or 'out.ilwd', a unique name is now assigned to the local\
                file.\n"
	append msg "\n* Fixed code which picks out SQL query text from the\
                LIGO_LW file, to deal with a change in behavior of LDAS.\n"
	append msg "\n* Increased block size for http transfers, to try to\
                improve speed of downloading large files.\n"
    }

    if { [CompareVersions $oldver < "3.29.0"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.29.0\n"
	append msg "\n* Changed default LDAS job proxy host from\
		sheratan.ligo.caltech.edu to mirfak.ligo.caltech.edu.\n"
	append msg "\n* The 'Concatenate frames' function in LDAS is now able\
		to produce valid output in frame format, so that format option\
		has been enabled in the 'Build frame data request' dialog.\n"
	append msg "\n* Fixed 'List all database tables' query to omit some\
		uninteresting tables which are used by LDAS to monitor\
		database operations.\n"
    }

    if { [CompareVersions $oldver < "3.29.1"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.29.1\n"
	append msg "\n* Fixed bug found by John Whelan: double-clicking on\
                a channel in a channel listing pasted more than just the\
                channel name into the parent window.\n"
    }

    if { [CompareVersions $oldver < "3.30.0"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.30.0\n"
	append msg "\n* Modified code to handle new frame cache format in\
                LDAS 1.0.  It still handles the frame cache format used by\
                previous versions of LDAS too.\n"
    }

    if { [CompareVersions $oldver < "3.30.1"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.30.1\n"
	append msg "\n* Bug fix when parsing new frame cache format.  (File\
		duration was always taken to be 1 second.)\n"
	append msg "\n* Bug fix to avoid occasional Tcl/Tk error reported\
                by Natalia.\n"
    }

    if { [CompareVersions $oldver < "3.31.0"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.31.0\n"
	append msg "\n* You can now specify one or more filenames on the\
		command line when you start guild, and it/they will be\
		immediately opened.  HOWEVER, this requires you to be using\
                version 3.31.0 or later of guild as your base version; this\
                feature is is NOT provided by web-patching.  If you use guild\
                from LIGOtools, use 'ligotools_update' to update your base\
                version.\n"
    }

    if { [CompareVersions $oldver < "3.32.0"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.32.0\n"
	append msg "\n* Added workaround for a bug in LDAS 1.0: if retrieving\
             data from a frame file containing data from more than one site,\
             LDAS currently requires you to use the '-ifo' option to specify\
             the frame prefix (e.g. 'HL').  This will be fixed in the next\
             release of LDAS.  In the meantime, modified code so that if the\
             user specifies an 'Other' site in the field below the\
             'List channels' part of the dialog box, then that is passed on\
             to LDAS as part of the frame query.  (Also made this 'Other'\
             site case-insensitive.)\n"
	append msg "\n* In the 'Build Frame Data Request' dialog box, added\
             radiobuttons so that the user can specify whether the channels\
             being extracted are raw (i.e. in 'FrAdcData' structures in the\
             input frame file) or processed (i.e. in 'FrProcData'\
             structures).  This does not affect createRDS jobs, but does\
             affect other user commands such as concatFrameData.\n"
    }

    if { [CompareVersions $oldver < "3.32.1"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.32.1\n"
	append msg "\n* Fix bad Tcl source code (comments within a switch\
	     structure) which caused problems with some versions of Tcl.\n"
    }

    if { [CompareVersions $oldver < "3.32.2"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.32.2\n"
	append msg "\n* Added code to determine table name from attribute of\
               Table element, so that table names are shown in window titles\
               when displaying contents of a LIGO_LW file generated by a\
               LALApps program.\n"
    }

    if { [CompareVersions $oldver < "3.32.3"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.32.3\n"
	append msg "\n* Added 's3a' databases (lho_s3a, etc.) to list of\
	    available databases.\n"
    }

    if { [CompareVersions $oldver < "3.32.4"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.32.4\n"
	append msg "\n* If an 's3a' database (or anything else other than an\
            's3' database) is selected at the time you open a build-query\
            dialog, then the data epoch is now 'All times' by default.\n"
    }

    if { [CompareVersions $oldver < "3.32.5"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.32.5\n"
	append msg "\n* Change Tk text widget fixes hard-coded in guild to be\
                ignored when using Tcl/Tk version 8.4, since they are\
                incompatible as written.  Also change scrolledtable widget\
	        functions to call tk functions in tk:: namespace.\n"
    }

    if { [CompareVersions $oldver < "3.32.6"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.32.6\n"
	append msg "\n* Change time epoch specification from text strings to\
	        explicit GPS times, to avoid startup problems encountered by\
	        Stas Babak which are due to some trouble dealing with U.S.\
	        time zones.\n"
    }

    if { [CompareVersions $oldver < "3.32.7"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.32.7\n"
	append msg "\n* Add E11 databases, and make them the defaults for\
	        queries.\n"
    }

    if { [CompareVersions $oldver < "3.33.0"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.33.0\n"
	append msg "\n* Use getFrameData instead of createRDS in standard\
	        frame data request.\n"
    }

    if { [CompareVersions $oldver < "3.33.1"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.33.1\n"
	append msg "\n* Workaround for bug in LDAS version 1.4 which sometimes\
	    caused an error when attempting to get the list of channels at the\
	    latest available time from a filesystem to which frame files are\
	    being added continuously.\n"
    }

    if { [CompareVersions $oldver < "3.34.0"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.34.0\n"
	append msg "\n* Added code to use the new persistent connection\
                feature in LDAS release 1.4, which makes the proxy server\
                unnecessary.  This method of communicating with the LDAS\
                manager will now be used by default with all LDAS systems\
	        except MIT, where LDAS 1.4 has not yet been installed. \
                There are items under the 'Connect' menu which allow the user\
                to have the option of using the proxy server or\
                making a direct (transient) connection to the LDAS manager.\n"
	append msg "\n* Fixed list of databases on the Dev system.\n"
	append msg "\n* Added E12 databases at LHO, LLO, and CIT,\
	    and E11 database at MIT.\n"
	append msg "\n* Removed UWM and PSU from list of LDAS servers.\n"
    }

    if { [CompareVersions $oldver < "3.34.1"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.34.1\n"
	append msg "\n* Added S4 databases, and made them the defaults for\
                queries.\n"
    }

    if { [CompareVersions $oldver < "3.35.0"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.35.0\n"
	append msg "\n* Update persistent socket code to work with new\
                persistent socket protocol to work from behind a NAT router.\n"
	append msg "\n* Change 'Operate through firewall?' option to 'Use\
                proxy server?'.  The behavior is the same, but the name is\
                more accurate.\n"
	append msg "\n* Remove option to turn off password encryption --\
	        password encryption is now mandatory.\n"
    }

    if { [CompareVersions $oldver < "3.35.1"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.35.1\n"
	append msg "\n* Update list of databases to include S5 data bases\
	        at LHO and LLO, and make them the defaults for queries.\n"
    }

    if { [CompareVersions $oldver < "3.36.0"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.36.0\n"
	append msg "\n* Make code aware of leap second at end of\
	        December 31, 2005.\n"
	append msg "\n* Added support for MJD (modified Julian day) to\
                time converter utility.\n"
    }
	if { [CompareVersions $oldver < "3.37.0"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.37.0\n"
	append msg "\n* Added cit_s5 to list of CIT databases, and made it\
	        the default for queries.\n"
	append msg "\n* Updated query window for gds_trigger table with\
                additional fields that can be used in the query.\n"
	append msg "\n* Generate an error if the user attempts to retrieve\
                frame data with a non-integer start or stop time.\n"
	append msg "\n* Corrected instructions for creating an LDAS problem\
	        report.\n"
    }

    if { [CompareVersions $oldver < "3.37.1"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.37.1\n"
	append msg "\n* Handle LDAS error messages about incorrect password\
	        or unknown user.\n"
    }
    
    if { [CompareVersions $oldver < "4.0.0"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 4.0.0\n"
	append msg "\n* Support the use of X509 certificates with LDAS via tclglobus"
    }
    return $msg
}


##=========================================================================
## Name: VersionMessagesPre323
##
## Description:
##   Returns messages about new versions of guild
##
## Parameters:
##   none
##
## Usage:
##   VersionMessagesPre323
##   VersionMessagesPre323 oldver
##
## Comments:
##   

proc VersionMessagesPre323 { {oldver ""} } {

    if { $oldver == "" } {
	set oldver $::guildrc(lastPatchVersion)
    }

    set msg ""

    ;##------ Messages start here

    if { [CompareVersions $oldver < "3.9.1"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.9.1\n"
	append msg "\n* In the \"Build Raw Data Request\" dialog, added an\
		entry widget to specify a data type other than the default\
		(full-rate raw data).  There is also a 'List' button to pop up\
		a window with a list of available data types.  (This 'List'\
		button becomes active after one clicks on the 'Check' button\
		to check the available time range and data types.\n"
	append msg "\n* Modified code to handle another change to the frame\
		cache format.\n"
	append msg "\n* Modified code to preserve names of files which\
		are downloaded if they already include the LDAS job ID.\n"
	append msg "\n* Modified code to convert to/from GPS time correctly,\
		regardless of the epoch of the system clock.  (Necessary due\
		to a change of the MacOS system clock epoch in Tcl/Tk 8.3.4)\n"
	append msg "\n* Minor bug fix in time converter utility: when the user\
		uses the pull-down menu to change the time zone, force the\
		display to update.\n"
    }

    if { [CompareVersions $oldver < "3.9.2"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.9.2\n"
	append msg "\n* In the \"Build Raw Data Request\" dialog, added an\
		entry widget to allow the user to specify an arbitrary\
		detector code (consisting of a single uppercase letter).\n"
	append msg "\n* Added a \"Details\" button near the top of a\
		build-query dialog (next to the \"List\" button), to get\
		detailed information about the columns in the table.\n"
	append msg "\n* Improved the logic for deciding whether a job (other\
		than a getMetaData job) succeeded or failed.\n"
	append msg "\n* Improved the robustness of the code which makes sure\
		a file is complete before downloading it; this is sometimes a\
		problem when LDAS is heavily loaded, and tells us our job is\
		done before the output is actually complete.\n"
	append msg "\n* Improved logic for deciding whether or not to prepend\
		the LDAS job ID for files which are downloaded.\n"
	append msg "\n* Improved reporting of names of files which were\
		downloaded.\n"
    }

    if { [CompareVersions $oldver < "3.9.3"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.9.3\n"
	append msg "\n* Modified code to use new syntax for getChannels\
		user command at all LDAS sites.\n"
	append msg "\n* Bug fix to distinguish reply messages from jobs\
		running simultaneously at multiple LDAS sites with the same\
		LDAS job ID.\n"
    }

    if { [CompareVersions $oldver < "3.10.0"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.10.0\n"
	append msg "\n* When appropriate, there is now a button in the lower\
		left corner of a table display window which allows you to get\
		more rows from the table, if the original query was limited\
		by you using the \"Maximum number of records to fetch\"\
		option, or by LDAS's restriction on the maximum number of rows\
		to return for any query."
	append msg "\n* Minor bug fix: disabled hypertext links in windows\
		listing job log entries.\n"
    }

    if { [CompareVersions $oldver < "3.10.1"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.10.1\n"
	append msg "\n* Updated the Raw Data Request to use the new LDAS\
		frame query syntax (not backward compatible with the old\
		syntax.)"
	append msg "\n* In the 'Build Raw Data Request' dialog, the start\
		time is no longer initialized to 'now'.\n"
	append msg "\n* Pop up a window with a warning message if the table\
		appears to have been truncated by the LDAS limit on the number\
		of rows returned (currently 10000)."
	append msg "\n* Widened the \"Maximum number of records to fetch\"\
		entry widget.\n"
	append msg "\n* Fixed bug which, in some cases, incorrectly reported\
		names of result files which were retrieved.\n"
	append msg "\n* Added code to check for duplicated result filenames\
		in the job-done message from LDAS.\n"
    }

    if { [CompareVersions $oldver < "3.11.0"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.11.0\n"
	append msg "\n* Added a pull-down menu just above the \"Qualifiers\"\
		area in most build-query dialog windows to query by \"epoch\",\
		e.g. a specific engineering run.  The epoch restriction\
		(if any) applies to all \"List\" queries invoked using the\
		buttons along the right edge of the \"Qualifiers\" area, as\
		well as to the main query.\n"
	append msg "\n* Added notes that the lho_2 and llo_2 databases apply\
		for runs E5 through E7.\n"
	append msg "\n* Modified parsing code to handle the case of a table\
		having two or more columns with the same name.\n"
	append msg "\n* No longer insert \"now\" when a time converter\
		is created.\n"
	append msg "\n* Generate error message if the output from an LDAS job\
		is not in the form of a http URL.\n"
    }

    if { [CompareVersions $oldver < "3.11.1"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.11.1\n"
	append msg "\n* Added option to sort database query output in\
		descending order.\n"
	append msg "\n* Fixed bug getting list of segment_groups from the\
		segment table.\n"
	append msg "\n* Remove the segment_definer table from the menu of\
		database tables, since it is not currently used.\n"
    }

    if { [CompareVersions $oldver < "3.11.2"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.11.2\n"
	append msg "\n* Fixed bug which introduced extra spaces into the 15th\
		line of a table written out to a text file.\n"
	append msg "\n* Removed the 'Abort' button from job status windows,\
		since at present the metadataAPI does not clean up properly\
		when a database query is aborted.\n"
	append msg "\n* Added an informational message with some suggestions\
		that pops up if a query is taking an unusually long time to\
		finish.\n"
    }

    if { [CompareVersions $oldver < "3.11.3"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.11.3\n"
	append msg "\n* Minor bug fix to allow degenerate time range (e.g.\
		\"690123456-690123456\") when requesting raw data.\n"
	append msg "\n* Bug fix in time conversion routines to work on\
		Albert's Mac.\n"
    }

    if { [CompareVersions $oldver < "3.12.0"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.12.0\n"
	append msg "\n* In the \"Build raw data query\" dialog, added an\
		estimate of output data volume and job execution time (only\
		calculated when the operation is \"Get frame data\" and the\
		format is \"Frame\").\n"
	append msg "\n* Minor enhancement in GPS time conversion.\n"
    }

    if { [CompareVersions $oldver < "3.13.0"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.13.0\n"
	append msg "\n* Added a \"Watch jobs\" feature to the \"Utilities...\"\
		menu.  This pops up a window with a list of the jobs which are\
		currently running on the LDAS system, as well as the jobs\
		which are pending.  The list automatically updates every 15\
		seconds or so.\n"
	append msg "\n* Minor bug fix: avoid generating an error if you close\
		a \"Build raw data query\" dialog while in the process of\
		retrieving the frame cache information.\n"
    }

    if { [CompareVersions $oldver < "3.14.0"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.14.0\n"
	append msg "\n* Re-worked the layout of the \"Watch jobs\" window; in\
		particular, it now displays the name of the user command, and\
		excludes any activeJobSummary jobs.\n"
	append msg "\n* Added the ability to query based on the \"user tag\"\
		which can be associated with an LDAS job using the '-userTag'\
		option of the dataPipeline user command.  A line has been\
		added to the qualifiers area of the build-query dialog for\
		all appropriate tables.\n"
	append msg "\n* Updated \"Build Raw Data Request\" dialog to update\
		the query every time a key is pressed or a mouse button is\
		clicked, so that the estimated output size and time is always\
		visible.\n"
	append msg "\n* Generalized the code which estimates the output size\
	        and time for a raw data request, so that it generates\
		estimates for all operations and return formats.\n"
	append msg "\n* Added a Help window, with examples, to the Time\
		Converter utility.\n"
	append msg "\n* Minor bug fixes related to Watch Jobs feature and\
		time conversion.\n"
    }

    if { [CompareVersions $oldver < "3.14.1"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.14.1\n"
	append msg "\n* Omit empty frame cache directories from \"Details\"\
		listing of available frame data.\n"
    }

    if { [CompareVersions $oldver < "3.14.2"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.14.2\n"
	append msg "\n* Added \"mit_e7\" to list of databases at MIT, and\
		made it the default for guild queries.  The other databases\
		at MIT can still be selected using the pulldown menu in the\
		main guild window.\n"
	append msg "\n* Added PSU system to list of available LDAS servers.\n"
    }

    if { [CompareVersions $oldver < "3.15.0"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.15.0\n"
	append msg "\n* Added CIT to the list of LDAS servers.\n"
	append msg "\n* When you click on the \"Details\" button in a \"Build\
		raw data request\" dialog, you now get a compact summary of\
		the frame cache contents, rather than the\
		directory-by-directory list that was displayed previously,\
		which was typically quite long.\n"
	append msg "\n* When connecting to an \"Other\" LDAS system, you now\
		enter the \"base port\" or the LDAS system, rather than the\
		managerAPI's operator socket.  Also added the usual base port\
		number as the default.\n"
	append msg "\n* When using the \"Get log entries for LDAS job\"\
		utility, if you click on \"Get log entries\" without entering\
		a job number or name, guild will now display a brief usage\
		message.  (Previously, this caused an LDAS error.)\n"
    }

    if { [CompareVersions $oldver < "3.16.0"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.16.0\n"
	append msg "\n* Added uwm_e7 and uwm_sim to list of databases at\
		UWM.\n"
	append msg "\n* For version 0.2 of LDAS (only on the Dev system\
		at present), added code to get frame cache information via\
		http rather than via an LDAS command, and added code to parse\
		new frame cache info format.  Also new for version 0.2 of\
		LDAS: when you open the \"Build Raw Data Request\" dialog,\
		it automatically checks the available time range (and faster\
		than before) without requiring you to click on the \"Check\"\
		button.\n"
	append msg "\n* Reworked the \"watch jobs\" facility to get active job\
		information by retrieving a file via http, rather than by\
		executing an LDAS command.  This is a big improvement,\
		since you can now watch jobs even when the system is heavily\
		loaded.\n"
	append msg "\n* Modified build-query dialogs for various tables to\
		include the nanoseconds field in the default list of columns\
		to order by.\n"
    }

    if { [CompareVersions $oldver < "3.16.1"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.16.1\n"
	append msg "\n* Enabled new frame-cache and watch-jobs features for\
		Test system.\n"
	append msg "\n* Changed frame cache details display so that it is\
		sorted first by detector and data type, then by time.\n"
    }

    if { [CompareVersions $oldver < "3.16.2"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.16.2\n"
	append msg "\n* Modified guild to expect new (LDAS 0.1) frame cache\
		format from all LDAS systems.\n"
    }

    if { [CompareVersions $oldver < "3.16.3"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.16.3\n"
	append msg "\n* Added code to pop up a message warning that frame\
		files retrieved using guild are written using version 5 of\
		the frame specification, which LIGOtools utilities cannot\
		currently read.\n"
	append msg "\n* Added new 'beta' databases (e.g. 'dev_beta') to the\
		menu of databases for a given LDAS system.  The 'beta'\
		database is now the default for guild queries on the dev and\
		test systems.\n"
	append msg "\n* Fixed bug in parsing frame cache info (failed to\
		account for duration of last frame in each directory).\n"
    }

    if { [CompareVersions $oldver < "3.17.0"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.17.0\n"
	append msg "\n* Added support for search_summary and search_summvars\
		tables.  The \"LDAS job info...\" submenu has been modified to\
		include menu choices to create build-query dialogs for these\
		tables.  The cross-referencing buttons/menus below displayed\
		tables have also been updated.\n"
	append msg "\n* Modified http client code to check HTTPPROXY and\
		HTTPPROXYBYPASS environment variables, and to act\
		accordingly.\n"
	append msg "\n* Modified code to get address of LDAS job proxy server\
		from the LJPROXY environment variable, if it is set.\n"
	append msg "\n* In getMetaData commands, switch from the deprecated\
		option '-returnformat' to '-outputformat'.\n"
    }

    if { [CompareVersions $oldver < "3.17.1"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.17.1\n"
	append msg "\n* Added 'channel' column to query dialog for\
		sngl_inspiral table.  The default query behavior is to require\
		this to be 'LSC-AS_Q' or else to be null.\n"
	append msg "\n* For UWM LDAS system, changed default database (for\
		queries) from 'uwm_test' to 'uwm_e7'.\n"
	append msg "\n* Bug fix when opening a URL for display: trim spaces\
		from the ends of the URL entered by the user.\n"
    }

    if { [CompareVersions $oldver < "3.18.0"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.18.0\n"
	append msg "\n* Added support for MD5-based password encryption when\
		communicating with LDAS.\n"
	append msg "\n* Fixed bugs in code which parses the reply message from\
		LDAS to determine whether a job succeeded or failed.\n"
	append msg "\n* Modified code to be smarter about determining the\
		location of output file(s) from an LDAS job.\n"
    }

    if { [CompareVersions $oldver < "3.19.0"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.19.0\n"
	append msg "\n* Updated list of databases on ldas-test system.\n"
	append msg "\n* Operate on new database tables: calib_info,\
		exttrig_search.\n"
	append msg "\n* Fixed bug that occasionally caused a Tcl error\
		condition when the watch-jobs window was closed.\n"
	append msg "\n* In build-data-query window, now report only the latest\
		available time, since the range is often misleading.\n"
	append msg "\n* Modified watch-jobs display to include the DSO name\
		(if known) in the case of running dataPipeline jobs.\n"
    }

    if { [CompareVersions $oldver < "3.19.1"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.19.1\n"
	append msg "\n* Modify code to now use password encryption protocol\
		for the ldas-test and ldas-cit systems.\n"
	append msg "\n* Fixed minor bugs in display of exttrig_search table\
		(cross-ref query construction; segment_type interpretation).\n"
    }

    if { [CompareVersions $oldver < "3.19.2"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.19.2\n"
	append msg "\n* Enable password encryption protocol for all LDAS\
		systems by default.  (You can still override this using a\
		switch in the \"Connect\" menu.)\n"
    }

    ;##------ Messages end here
    if { [CompareVersions $oldver < "3.19.3"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.19.3\n"
	append msg "\n* Added S1 databases at each side, and made them the\
		default at LHO and LLO.\n"
    }

    if { [CompareVersions $oldver < "3.19.4"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.19.4\n"
	append msg "\n* Added uwm_dev to list of databases.\n"
    }

    if { [CompareVersions $oldver < "3.19.5"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.19.5\n"
	append msg "\n* Bug fix in UseJobResults to handle case of a job\
		window being closed before info comes back (reported by\
		John Whelan).\n"
	append msg "\n* Fixed summ_value table definition to include 'ifo'\
		instead of 'ifos' (reported by Duncan Brown).\n"
	append msg "\n* Fixed \"watch jobs\" feature to handle the case of\
		receiving an incomplete file from LDAS (reported by John\
		Whelan).\n"
	append msg "\n* Corrected warning message about frame files retrieved\
		from LDAS not being readable by LIGOtools utilities.\n"
    }

    if { [CompareVersions $oldver < "3.20"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.20\n"
	append msg "\n* Changed the \"Raw Data Request\" feature so that it\
		uses the createRDS user command rather than getFrameData.\n"
	append msg "\n* Updated frame version 5 warning message to say that\
		the LIGOtools Fr package (v6r00) has been updated to be able\
		to read LDAS version 5 frames in SOME situations.\n"
	append msg "\n* Modified code so that if LDAS returns an ftp URL,\
		we change it to an http URL.\n"
	append msg "\n* Fixed bug in CheckFrameCache which occurred if the\
		\"Build Raw Data Request\" dialog was closed while the check\
		was in progress.\n"
    }

    if { [CompareVersions $oldver < "3.20.1"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.20.1\n"
	append msg "\n* Minor changes to \"watch jobs\" function:\n"
	append msg "-- Append a note if the job list has been truncated.\n"
	append msg "-- Changed refresh interval to 15 seconds,\
		to match the interval at which LDAS updates the information.\n"
	append msg "-- Fixed bug when parsing DSO shared-object names which\
		include a library version number.\n"
	append msg "\n* If a known intermittent error occurs when submitting\
		an LDAS job, add a note saying so to the error message which\
		is displayed.\n"
    }

    if { [CompareVersions $oldver < "3.20.2"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.20.2\n"
	append msg "\n* Added qualifier fields for search_summary,\
		search_summvars, and process_params tables to be able to query\
		based on the LDAS-job \"user tag\".\n"
	append msg "\n* Fixed some bugs which caused Tcl errors & stack traces\
		to be generated when windows were closed while guild was\
		busy doing something.\n"
	append msg "\n* Changed code to make the \"Next 10000 rows\" function\
		available in a few more cases.  If it can't be offered (e.g.)\
		because the set of columns retrieved does not include a\
		suitable unique ID), put a disabled button in the usual place\
		with a label which briefly indicates the reason.\n"
	append msg "\n* After the \"Maximum number of records to fetch\"\
		field, added a note to indicate the maximum imposed by LDAS.\n"
	append msg "\n* Fixed bug in code that infers an http URL from an\
		ftp URL.\n"
    }

    if { [CompareVersions $oldver < "3.20.3"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.20.3\n"
	append msg "\n* Updated warning message about version-5 frames to\
		reflect the existence of the v4r53mod version of the VIRGO\
		frame library.\n"
	append msg "\n* Fixed a bug when giving the URL of the manager API log\
		file, when the LDAS job proxy server is used.\n"
    }

    if { [CompareVersions $oldver < "3.20.4"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.20.4\n"
	append msg "\n* Added uwm_iul to list of databases at UWM.\n"
    }

    if { [CompareVersions $oldver < "3.20.5"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.20.5\n"
	append msg "\n* Re-enable code which automatically decides to use the\
		LDAS job proxy server when running on a machine whose IP\
		address belongs to a private network.\n"
    }

    if { [CompareVersions $oldver < "3.21.0"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.21.0\n"
	append msg "\n* Added uwm_s1 to list of databases.\n"
	append msg "\n* Revised the \"epoch\" selection list to include items\
		for the E8 and S1 runs, and removed items prior to E7.\n"
	append msg "\n* Revised the channel-list feature in the \"Build Raw\
		Data Request\" dialog so that you can specify the time for\
		which you want the list of valid channels, in case it differs\
		from the current channel list.\n"
    }

    if { [CompareVersions $oldver < "3.22.0"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.22.0\n"
	append msg "\n* Modified code to handle the new LDAS message syntax\
		for giving the location of output file(s).\n"
	append msg "\n* Modified raw-data query to allow user to request\
		down-sampled data.  Also updated size/time estimate code to\
		take this into account.\n"
	append msg "\n* Modified raw-data query construction code to tolerate\
		variations on the resampling syntax if explicitly specified\
		by the user.\n"
	append msg "\n* Fixed bug which sometimes caused channel list to be\
		incorrect when no explicit time was specified.\n"
	append msg "\n* Fixed bug which prevented getting raw data for more\
		than one channel in LIGO_LW or ilwd format.\n"
    }

    if { [CompareVersions $oldver < "3.22.1"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.22.1\n"
	append msg "\n* Updated the warning message about frame format\
		versions to reflect the recent release of LDAS which writes\
		out version-6 frames.\n"
	append msg "\n* Changed the names of frame files retrieved from\
		LDAS.\n"
	append msg "\n* Fixed a bug when querying the sngl_unmodeled table:\
		column 'name' no longer exists, having been replaced by\
		'search'.\n"
    }

    if { [CompareVersions $oldver < "3.22.2"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.22.2\n"
	append msg "\n* Updated code to always use the LDAS job proxy server\
		when running at LLO and connecting to an LDAS system other\
		than the one at LLO.  This works around the LLO firewall\
		without requiring users to remember to set the 'Operate\
		through firewall' setting.\n"
    }

    if { [CompareVersions $oldver < "3.22.3"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.22.3\n"
	append msg "\n* Revised list of databases on the Dev system.\n"
	append msg "\n* Added dialog to build query for WaveBurst table, and\
		set up cross-reference feature when displaying data from the\
		WaveBurst table.\n"
    }

    if { [CompareVersions $oldver < "3.22.4"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.22.4\n"
	append msg "\n* Fixed a bug which prevented sorting by two or more\
		columns in descending order.  (Only the last column was sorted\
		in descending order.)\n"
	append msg "\n* Updated list of databases on ldas-test system.\n"
    }

    if { [CompareVersions $oldver < "3.22.5"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.22.5\n"
	append msg "\n* Added uwm_s1_s to list of databases at UWM.\n"
    }

    return $msg
}


##=========================================================================
## Name: VersionMessagesPre39
##
## Description:
##   Returns messages about new versions of guild
##
## Parameters:
##   none
##
## Usage:
##   VersionMessagesPre39
##   VersionMessagesPre39 oldver
##
## Comments:
##   

proc VersionMessagesPre39 { {oldver ""} } {

    if { $oldver == "" } {
	set oldver $::guildrc(lastPatchVersion)
    }

    if { $::rcFileState == "new" } {
	set show 0
    } else {
	set show 1
    }

    set msg ""

    ;##------ Messages start here

    if { [CompareVersions $oldver < "2.5"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 2.5\n"
	append msg "\n* First general release.\n"
    }

    if { [CompareVersions $oldver < "2.5.1"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 2.5.1\n"
	append msg "\n* Fixed bug which prevented display of the result when\
		one used the 'Just count number of matching records' option,\
		or when a query matched no records.\n"
	append msg "\n* Fixed bug which interfered with saving table contents\
		when the main guild window was iconified.\n"
	append msg "\n* Added new query-building feature: count records,\
		grouping by certain column(s).\n"
	append msg "\n* Added a button to display the full SQL query in a\
		separate window (and removed double-click binding which used\
		to do the same thing).\n"
	append msg "\n* Added more information to 'Version information'\
		screen.\n"
	append msg "\n* Improved error messages resulting from communication\
		errors.\n"
	append msg "\n* Modified status display to consider a job to be\
		running until after the result table is actually built.\n"
	append msg "\n* Fixed bug which prevented multiple message windows.\n"
    }

    if { [CompareVersions $oldver < "2.5.2"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 2.5.2\n"
	append msg "\n* Fixed bug which prevented display of multiple tables\
		from a single LIGO_LW file.\n"
        append msg "\n* Added code to override *foreground and *background\
		color specifications from X resource database.  Will now\
		always use usual Tcl/Tk color scheme, unless you specify\
		command-line options (-fg, -bg, -activebg, -troughcolor)\
		\[available only if base version is 2.5.2 or later\].\n"
    }

    if { [CompareVersions $oldver < "2.5.3"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 2.5.3\n"
	append msg "\n* Standardized font used in tables, etc. to be\
		Courier 12.\n"
    }

    if { [CompareVersions $oldver < "2.5.4"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 2.5.4\n"
	append msg "\n* Fixed handling of LDAS manager response message,\
		which had been modified.\n"
	append msg "\n* Fixed bug which sometimes allowed the row-number area\
		and main text area to fall out of sync when scrolled with\
		the vertical scrollbar 'thumb'.\n"
    }

    if { [CompareVersions $oldver < "3.0"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.0\n"
	append msg "\n* Incorporated Alex's code to retrieve frame data,\
		and added a button to check what time range is available\
		from the LDAS frameAPI.\n"
	append msg "\n* Added ability to change font size, from new 'Display'\
		menu in main guild window.  Also added ability to skip table\
		display and just write query output to a file.\n"
	append msg "\n* Added event-driven code to return control to user\
		while a job is pending.\n"
	append msg "\n* Improved retrieval of LDAS log entries for jobs\
		which end with an error.  Uses html rendering code\
		copied from genericAPI.\n"
        append msg "\n* Removed timeout from http transfers, to allow large\
		files to be transferred.  Added code to make sure entire\
		file is available on the web server before starting the\
		transfer.\n"
	append msg "\n* Improved handling of date-time strings when building\
		queries, to allow arithmetic expresssions.\n"
	append msg "\n* Made a few minor changes to accommodate Tcl/Tk\
		version 8.4.\n"
	append msg "\n* Various bug fixes and enhancements.\n"
    }

    if { [CompareVersions $oldver < "3.1"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.1\n"
	append msg "\n* Simplified the main guild window, by putting all\
		of the metadata menubuttons into a cascaded pulldown menu.\n"
	append msg "\n* Added a 'Utilities' pulldown menu, with a nifty Time\
		Converter utility.\n"
	append msg "\n* Made some improvements in handling date/time\
		strings.\n"
    }

    if { [CompareVersions $oldver < "3.1.1"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.1.1\n"
	append msg "\n* Fixed bug which checked ALL integer values to\
		determine whether they were reasonable as GPS times.\n"
	append msg "\n* Fixed a few minor bugs in Time Converter utility.\n"
    }

    if { [CompareVersions $oldver < "3.2"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.2\n"
	append msg "\n* Added an item to the Utilities menu to retrieve\
		the log entries for an earlier LDAS job.\n"
	append msg "\n* Added a help window for the Build Raw Data Request\
		dialog.\n"
	append msg "\n* Made frames the default return format for raw data\
		requests.\n"
	append msg "\n* Changed the guild home page, and the web patch server,\
		from ldas-dev to ldas-sw.\n"
	append msg "\n* Added code to save web-patch file on local disk,\
		and to use it later if the web site is unreachable.\n"
    }

    if { [CompareVersions $oldver < "3.2.1"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.2.1\n"
	append msg "\n* Added \"Save Settings\" item to File menu, to store\
		the current LDAS server, return format, font size, etc. for\
		use by later invocations of guild.\n"
	append msg "\n* Bug fixes in time converter, and when saving table\
		as a text file with row numbers included.\n"
	append msg "\n* Improved query speed for tables containing both\
		start_time and end_time columns.\n"
    }

    if { [CompareVersions $oldver < "3.2.2"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.2.2\n"
	append msg "\n* Minor bug fixes.\n"
    }

    if { [CompareVersions $oldver < "3.3"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.3\n"
	append msg "\n* More robust standalone executable.\n"
    }

    if { [CompareVersions $oldver < "3.3.1"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.3.1\n"
	append msg "\n* Moved position of \"GDS triggers\" menu item.\n"
    }

    if { [CompareVersions $oldver < "3.3.2"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.3.2\n"
	append msg "\n* Added LDAS Test system to menu of servers.\n"
	append msg "\n* Minor bug fixes.\n"
    }

    if { [CompareVersions $oldver < "3.3.3"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.3.3\n"
	append msg "\n* Added workaround for machines which\
		don't know their own IP address.\n"
    }

    if { [CompareVersions $oldver < "3.3.4"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.3.4\n"
	append msg "\n* On most windows, added a button to raise the main\
		guild window (which tends to get lost behind other windows).\n"
	append msg "\n* Cosmetic changes.\n"
    }

    if { [CompareVersions $oldver < "3.4"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.4\n"
	append msg "\n* Modified to handle new LDAS user command syntax and\
		message format.\n"
	append msg "\n* Improved GUI for submitting arbitrary LDAS user\
		commands.  Now allows one to start \"background\" jobs and\
		receive messages via email (whether or not guild is still\
		running). \n"
	append msg "\n* Indicate directory in which files are created.\n"
	append msg "\n* A few cosmetic changes.\n"
    }

    if { [CompareVersions $oldver < "3.4.1"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.4.1\n"
	append msg "\n* Fixed bug constructing list of channels when\
		retrieving raw data from LDAS.\n"
	append msg "\n* Added support for connecting to LDAS systems other\
		than the canonical LIGO-lab ones.\n"
	append msg "\n* Added a menu choice to allow user to change the\
		current working directory.\n"
	append msg "\n* Added a menu choice to clear the saved settings.\n"
    }

    if { [CompareVersions $oldver < "3.4.2"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.4.2\n"
	append msg "\n* Add separate options for binary vs. ascii ilwd\
		formatting when retrieving raw data.\n"
    }

    if { [CompareVersions $oldver < "3.4.3"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.4.3\n"
	append msg "\n* Minor bug fixes.\n"
    }

    if { [CompareVersions $oldver < "3.4.4"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.4.4\n"
	append msg "\n* Fixed XML parsing to handle new formatting conventions\
		for special characters.\n"
    }

    if { [CompareVersions $oldver < "3.5"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.5\n"
	append msg "\n* Added support for multiple database instances at\
		each LDAS server, selected by name from a pulldown menu\
		in the main guild window.\n"
	append msg "\n* Added the ability to abort an LDAS job while it is\
		running.\n"
	append msg "\n* Fixed code to handle rare case of being told that\
		a job is finished before being told that it has started.\n"
	append msg "\n* Removed special behavior of arrow keys and Return key\
		in \"Arbitrary database query\" and \"LDAS user command\"\
		dialog boxes.  You can now put parts of the user command on\
		separate lines for readability, if you want.\n"
    }

    if { [CompareVersions $oldver < "3.5.1"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.5.1\n"
	append msg "\n* Fixed a bug which showed up with Tcl/Tk 8.3.3.\n"
	append msg "\n* Changed queries on text values to be case sensitive\
		by default.  This should often be faster than case-insensitive\
		matching (which was the previous default) because DB2 may take\
		advantage of an index.\n"
	append msg "\n* Added a build-query dialog for the summ_csd table.\n"
    }

    if { [CompareVersions $oldver < "3.5.2"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.5.2\n"
	append msg "\n* Updated list of qualifiers in build-query dialog\
		for sngl_inspiral table.\n"
    }

    if { [CompareVersions $oldver < "3.6.0"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.6.0\n"
	append msg "\n* Added a new standard query, \"List wrapperAPI jobs\",\
		under the \"LDAS metadata database...\" pull-down menu.\n"
	append msg "\n* Added the ability to query based on LDAS job number,\
		in the build-query dialogs for various tables.\n"
    }

    if { [CompareVersions $oldver < "3.7.0"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.7.0\n"
	append msg "\n* Made several improvements to the\
		\"LDAS User Command\" dialog:\n"
	append msg "- Added the ability to save/load user command to/from\
		a file.\n"
	append msg "- Modified the history stack to keep track of\
		filenames as well as the user commands themselves.\n"
	append msg "- Cleaned up the layout of the window.\n"
	append msg "- Added a \"Help\" button, which brings up a\
		help window.\n"
	append msg "- Added code to save settings (foreground vs.\
		background job, etc.) when the user does \"Save Settings\".\n"
	append msg "\n* Added a \"raise all\" button in the corner of the\
		main guild window, to bring all guild windows in front of all\
		non-guild windows.\n"
	append msg "\n* Added a \"Raise/deiconify window\" function under the\
		\"Display\" menu.\n"
	append msg "\n* Added a \"Revision history\" choice under the\
		Help menu.\n"
	append msg "\n* Made some modifications to support MacOS.\n"
	append msg "\n* Sped up time conversion, and made the time converter\
		refresh continuously when the time string begins with \"now\",\
		so you can use it as a clock without having to manually\
		refresh it.\n"
	append msg "\n* Improved robustness of web-patching over a slow\
		modem connection.\n"
	append msg "\n* Added an 8-point option for the font size.\n"
	append msg "\n* Several minor cosmetic changes.\n"
    }

    if { [CompareVersions $oldver < "3.7.1"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.7.1\n"
	append msg "\n* Minor bug fix when doing \"raise all\".\n"
	append msg "\n* Do a check to make sure user submits only the \"bare\"\
		LDAS command, i.e. omitting the \"ldasJob\".\n"
    }

    if { [CompareVersions $oldver < "3.7.2"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.7.2\n"
	append msg "\n* Improved guild's ability to determine the IP address\
		of the computer on which it is running.\n"
    }

    if { [CompareVersions $oldver < "3.7.3"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.7.3\n"
	append msg "\n* Another fix to try to improve guild's ability to\
		determine the IP address of the computer on which it is\
		running.\n"
    }

    if { [CompareVersions $oldver < "3.7.4"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.7.4\n"
	append msg "\n* Tweaked code to allow Windows and Mac users to\
		select text in disabled text widgets and entry widgets.\n"
	append msg "\n* Minor bug fix to handle case where build-query\
		window is closed before \"List\" query is finished.\n"
	append msg "\n* Minor cosmetic changes in \"LDAS User Command\"\
		window.\n"
	append msg "\n* In Time Converter window, enable looping if input\
		string begins with \"now\", so that we have a free-running\
		clock.\n"
    }

    if { [CompareVersions $oldver < "3.7.5"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.7.5\n"
	append msg "\n* Added databases \"lho_2\" and \"llo_2\" to list of\
		available database names.\n"
	append msg "\n* In pull-down menu of database names, added a comment\
		about what data runs correspond to each database.\n"
    }

    if { [CompareVersions $oldver < "3.7.6"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.7.6\n"
	append msg "\n* Determinine the table name from the query text, since\
		LDAS no longer supplies it explicitly.  This is necessary to\
		bring up the cross-reference buttons below the table.\n"
	append msg "\n* Increase maximum default width of a column to 22\
		characters so that double-precision numbers are displayed\
		without obscuring the exponent.\n"
    }

    if { [CompareVersions $oldver < "3.8.0"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.8.0\n"
	append msg "\n* Added a build-query dialog for the external_trigger\
		table.\n"
	append msg "\n* Added code to display the colored 'balls' that\
		appear in LDAS html log files.\n"
    }

    if { [CompareVersions $oldver < "3.8.1"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.8.1\n"
	append msg "\n* Added MIT to list of LDAS servers.\n"
	append msg "\n* Changed default database for each site from 'default'\
		(i.e. the LDAS default) to an explicit database -- in\
		particular, 'lho_2' at Hanford and 'llo_2' at Livingston.\
		This is to help avoid confusion in case LDAS is accidentally\
		restarted with an inappropriate default database.\n"
	append msg "\n* Bug fix when retrieving metadata in ilwd format\
		(rather than the usual LIGO_LW format).\n"
    }

    if { [CompareVersions $oldver < "3.8.2"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.8.2\n"
	append msg "\n* Updated code to query on jobid stored in the process\
		table, rather than the old method of querying on the value of\
		the '-jobID' parameter in the process_params table.\n"
	append msg "\n* Added build-query dialogs for summ_mime and sngl_mime\
		tables.\n"
	append msg "\n* Updated some cross-reference buttons to include\
		summ_mime and sngl_mime.\n"
	append msg "\n* Modified build-query default settings so that for\
		tables with BLOBs (Binary Large OBjects), all columns EXCEPT\
		the BLOB itself are returned.  This lets you examine the\
		contents of the table without the overhead of retrieving the\
		BLOBs themselves.\n"
	append msg "\n* In the message that is displayed the first time\
		someone uses guild, added a note that the LDAS\
		username/password required when using guild is NOT the same as\
		any Unix username/password.  Also added a Help button, giving\
		the same information, on the window which pops up to prompt\
		for the username/password.\n"
	append msg "\n* Added code to allow guild to work properly from behind\
		a firewall, using a proxy server running at Caltech.  To make\
		use of this feature, you must set the\
		\"Operate through firewall?\"\ option (under the \"Connect\"\
		menu in the main guild window) to \"yes\".\n"
    }

    if { [CompareVersions $oldver < "3.8.3"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.8.3\n"
	append msg "\n* Fixed bug which caused an LDAS database error message\
		when querying based on LDAS job ID.\n"
	append msg "\n* Fixed minor bug when getting a list of LDAS job IDs,\
		which caused the list to be out of order.\n"
	append msg "\n* In the build-query dialog for the external_trigger\
		table, added a comparison based on insertion time.\n"
	append msg "\n* Keep the \"main\" button in a job-status window\
		even after the job has finished, for convenience.\n"
    }

    if { [CompareVersions $oldver < "3.8.4"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.8.4\n"
	append msg "\n* For the ldas-dev system, take advantage of the\
		manager's new ability to automatically determine the IP\
		address of the client.  This allows a broader group of users\
		to get the results back from LDAS jobs without having to make\
		use of the \"Operate through firewall?\" option.\n"
	append msg "\n* When communicating with a version of LDAS which does\
		not have the ability to automatically determine our IP\
		address, guild now checks whether its IP address is in one of\
		the ranges reserved for \"private\" networks (meaning there\
		must be a router mapping it to something else).  If so,\
		guild automatically switches on the \"Operate through\
		firewall?\" option.\n"
	append msg "\n* The \"explicitIP\" workaround, which had been used by\
		a few people to work through a mapping router, is no longer\
		supported since the new code should take care of this\
		situation more robustly.\n"
	append msg "\n* Added code to parse new format of information\
		returned by the getFrameCache command.\n"
	append msg "\n* In the \"Build Raw Data Request\" dialog, added a\
		\"Details\" button to give full information about the\
		available time intervals, since in general the data might\
		be non-contiguous.\n"
    }

    if { [CompareVersions $oldver < "3.8.5"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.8.5\n"
	append msg "\n* Increased maximum default width of a column to 22\
		characters so that double-precision numbers are displayed\
		without obscuring the exponent.  (Previous attempt to change\
		this didn't take effect, for obscure technical reasons.)\n"
	append msg "\n* Added cross-reference buttons to retrieve BLOBs\
		for tables for which they are not retrieved by default\
		(summ_spectrum, etc.).\n"
	append msg "\n* Added more comparison types for querying based on\
		LDAS job ID.\n"
	append msg "\n* Fixed bug which caused guild to claim that an error\
		had occurred after a successful putMetaData command.\n"
    }

    if { [CompareVersions $oldver < "3.8.6"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.8.6\n"
	append msg "\n* Added UWM to list of LDAS servers.\n"
	append msg "\n* Fixed code to handle empty frame cache gracefully.\n"
	append msg "\n* Minor bug fix when picking out SQL queries from a\
		LIGO_LW file containing more than one Table object.\n"
	append msg "\n* Fix ilwd parsing code to pick out the SQL query from\
		the new place that LDAS puts it.  (Backwards-compatible.)\n"
	append msg "\n* Display an informative error message if user attempts\
		to read an ilwd file with more than one ilwd object within the\
		outermost container.\n"
    }

    if { [CompareVersions $oldver < "3.8.7"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.8.7\n"
	append msg "\n* Updated list of databases at UWM.\n"
	append msg "\n* Changed code to assume that all LDAS installations\
		have the new feature of being able to automatically determine\
		the IP address of the client.\n"
	append msg "\n* Minor bug fix to omit the 'order by' clause if the\
		list of columns to order by is empty.\n"
	append msg "\n* Minor bug fix to disable 'Details' button from doing\
		anything if the frame cache is empty.\n"
    }

    if { [CompareVersions $oldver < "3.8.8"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.8.8\n"
	append msg "\n* Added ldas_tst database at all LIGO Lab LDAS sites.\n"
	append msg "\n* Modified code so that the site and database always\
		appears in the window title.\n"
	append msg "\n* Improved the label text appearing above a listbox\n"
	append msg "\n* Improved icon names (generally, shorthand versions of\
		window titles).\n"
    }

    if { [CompareVersions $oldver < "3.8.9"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.8.9\n"
	append msg "\n* Added uwm_e5 to list of databases at UWM.\n"
    }

    if { [CompareVersions $oldver < "3.9.0"] } {
	append msg "\n\n=============> SUMMARY OF CHANGES FOR VERSION 3.9.0\n"
	append msg "\n* Modified code to work with new frame cache format.\n"
	append msg "\n* Modified code to use new syntax for getChannels\
		command (only on the Dev system for now).\n"
	append msg "\n* Changed code so that a \"Build Raw\ Data Request\"\
		dialog now applies to a specific LDAS server (the one listed\
		as the \"Current LDAS server\" when the dialog is created),\
		and is not affected by any subsequent change to the \"Current\
		LDAS server\" in the main guild window.\n"
	append msg "\n* In the \"Build Raw Data Request\" dialog, added\
		radiobuttons to select a particular interferometer (at sites\
		which have data for more than one interferometer).\n"
	append msg "\n* In the \"Build Raw Data Request\" dialog, added an\
		option to allow gaps in a concatFrameData request.\n"
	append msg "\n* Modified code to make error messages pop up on top of\
		the relevant dialog, rather then on top of the main guild\
		window.\n"
    }

    ;##------ Messages end here

    return $msg
}

##=========================================================================
## Name: InfoMessages
##
## Description:
##   Returns new informational messages
##
## Parameters:
##   ?oper? -- if equal to "count", just returns the total number of messages.
##
## Usage:
##   InfoMessages
##   InfoMessages count
##
## Comments:
##   

proc InfoMessages { {oper ""} } {

    set nmsg 0

    if { $oper == "count" || $::rcFileState == "new" } {
	set show 0
	set lastmsg 0
    } else {
	set show 1
	set lastmsg $::guildrc(lastMsgRead)
    }

    set msg ""

    ;##------ Messages start here

    incr nmsg
    if { $show == 1 && $nmsg > $lastmsg } {
	append msg "\nMessage to guild users, posted 17 May 2000:\n"
	append msg "This is a sample informational message.\n"
    }

    incr nmsg
    if { $show == 1 && $nmsg > $lastmsg } {
	append msg "\nMessage to guild users, posted 17 May 2000:\n"
	append msg "This is another sample informational message.\n"
    }

    ;##------ Messages end here

    if { $oper == "count" } {
	return $nmsg
    } else {
	return $msg
    }
}

##=========================================================================
## Name: WriteGuildRc
##
## Description:
##   Routine to write out updated $HOME/.guildrc file
##
## Parameter:
##   forceflag -- if present, then file will be written out regardless of
##                 whether the version number has changed
##
## Usage:
##   WriteGuildRc ?force?
##
## Comments:
##   Called by GuildMain.

proc WriteGuildRc { {forceflag ""} } {
###    puts "In WriteGuildRc"

    if { $::rcFileState == "no_home" || $::rcFileState == "unreadable" } {
	return
    }

    ;##- Do not update the .guildrc file if web-patching failed,
    ;##- unless the forceflag was specified
    if { $::guildPatchStatus != "OK" && [string is space $forceflag] } {
	return
    }

    set changed 0
    if { $::guildVersion != $::guildrc(lastBaseVersion) } {
	set ::guildrc(lastBaseVersion) $::guildVersion
	set changed 1
    }
    if { $::guildPatchVersion != $::guildrc(lastPatchVersion) } {
	set ::guildrc(lastPatchVersion) $::guildPatchVersion
	set changed 1
    }
    if { $::totalInfoMessages > $::guildrc(lastMsgRead) } {
	set ::guildrc(lastMsgRead) $::totalInfoMessages
	set changed 1
    }

    ;##- Don't update the .guildrc file if nothing has changed, unless
    ;##- the forceflag was specified
    if { $changed == 0 && [string is space $forceflag] } { return }

    if { [catch {open $::rcFile w} fhandle] } {
	set ignore [ tk_messageBox -type ok -icon warning \
		-title "Cannot update your .guildrc file" \
		-message "WARNING: guild cannot update the .guildrc file in\
		your home directory.  Therefore, you may receive the same\
		informational messages multiple times. \
		Otherwise, guild will function normally." ]
	return
    }

    ;##- Now write out the guildrc array values into the file
    foreach {index value} [array get ::guildrc] {
	puts $fhandle [list $index $value]
    }

    catch {close $fhandle}

    return
}


##=========================================================================
## Name: GetDbUser
##
## Description:
##   Routine to pop up a window and let the user enter or change the username
##   and password used to connect to the database.
##
## Usage:
##   GetDbUser
##
## Comments:
##   Called the first time the user submits a database query.  Also can
##   be called from the "Connect" menu.

proc GetDbUser {} {

    ;##- Create a new window for input
    set tl .getuser
    if {[winfo exists $tl]} {
	switch -- [wm state $tl] {
	    normal { raise $tl; focus $tl }
	    iconic { wm deiconify $tl; focus $tl }
	}
	return ""
    } else {
	NewToplevel $tl
	wm title $tl "Set LDAS username and password"
    }

    ;##- Set up widgets
    label $tl.userlabel -text "LDAS username:"
    label $tl.passlabel -text "LDAS password:"
    entry $tl.userval -width 16
    entry $tl.passval -width 16 -show "*"

    frame $tl.barea
    button $tl.barea.ok -text "OK" -default normal \
	    -command [selsub {
	set dbuser [$tl.userval get]
	set dbpass [$tl.passval get]
	destroy $tl
	update idletasks
    } tl ]
    button $tl.barea.cancel -text Cancel -command "destroy $tl"
    button $tl.barea.help -text Help -command "BigMessageBox -icon info \
		-title \"Help on username/password\" \
		-message \"To submit any LDAS job (including a database query),\
		you must have a valid LDAS username/password, which is NOT the\
		same as any Unix account you have.  See\
  http://www.ldas-sw.ligo.caltech.edu/ligotools/faq/get_ldas_username.html\
                for information about getting an LDAS username/password.\""

    ;##- Insert the current values (if any) into the entry widgets
    global dbuser dbpass
    if { [info exists dbuser] } {
	$tl.userval insert end $dbuser
	$tl.passval insert end $dbpass
    }

    ;##- Bind the return key for convenience
    bind $tl.userval <Return> "focus $tl.passval"
    bind $tl.passval <Return> "$tl.barea.ok invoke"

    ;##- Set up focus bindings to show the Ok button as the default button
    ;##- When appropriate
    bind $tl.passval <FocusIn> "$tl.barea.ok config -default active"
    bind $tl.passval <FocusOut> "$tl.barea.ok config -default normal"
    
    ;##- Lay out the widgets
    grid $tl.barea.ok $tl.barea.cancel $tl.barea.help
    grid $tl.userlabel $tl.userval -sticky news
    grid $tl.passlabel $tl.passval -sticky news
    grid $tl.barea -columnspan 2 -sticky ns
    grid columnconfigure $tl 1 -weight 1

    ;##- Set focus to the username entry widget
    focus $tl.userval

    ;##- Grab the focus
    set oldfocus [focus]
    focus $tl
    update idletasks
    catch {tkwait visibility $tl}
    ####catch {grab $tl}

    ;##- Wait for the window to be destroyed
    tkwait window $tl

    ;##- Release the focus
    ####catch {grab release $tl}
    focus $oldfocus

    return
}

##=========================================================================
## Name: GetLdaspwUser
##
## Description:
##   Get LDAS username out of ~/.ldaspw, if it exists
##
## Comments:
##   Bails out for shared accounts like 'ops'

proc GetLdaspwUser {} {

    #-- Check our username
    switch -- $::tcl_platform(user) {
	"ops" - "controls" - "gds" - "ldas" - "ldasdb" - "root" - "install" {
	    return
	}
    }

    set file "~/.ldaspw"
    if { [file exists $file] && [file readable $file] } {
        if { ! [catch {open $file r} fid] } {

	    global dbuser dbpass

            ;##- Read in the list of usernames and encoded passwords
            set userlist {}
            while { ! [eof $fid] } {
                gets $fid line
                if {[regexp {^(\w+)\s+([0-9A-F]+)} $line match user encpw]} {
                    ;##- The first listing is the default user
		    set dbuser $user
		    set dbpass $encpw
		    close $fid
		    return
                }
            }
            close $fid

        }
    }

    return
}

##=========================================================================
## Name: GetOtherDb
##
## Description:
##   Routine to pop up a window and let the user enter or change the hostname,
##   port number, and (optionally) the database instance name for the "Other"
##   database server.
##
## Usage:
##   GetOtherDb
##
## Comments:
##   Called the first time the user selects the "Other" database from the
##   pulldown menu.  Also can be called from the "Connect" menu.

proc GetOtherDb {} {

    ;##- Create a new window for input
    set tl .getdb
    if {[winfo exists $tl]} {
	switch -- [wm state $tl] {
	    normal { raise $tl; focus $tl }
	    iconic { wm deiconify $tl; focus $tl }
	}
	return ""
    } else {
	NewToplevel $tl
	wm title $tl "Set address of \"Other\" database server"
    }

    ;##- Set up widgets
    label $tl.hostlabel -text "Hostname:"
    label $tl.portlabel -text "Base port:"
    label $tl.globusportlabel -text "Globus channel port:"
    label $tl.instlabel -text "DB name:"
    label $tl.instnote -text "(leave blank for default)"
    entry $tl.hostval -width 32
    entry $tl.portval -width 32
    entry $tl.instval -width 9
	entry $tl.globusportval -width 9
    
    frame $tl.barea
    button $tl.barea.ok -text "OK" -default normal \
	    -command [selsub {
	set ::otherdbhost [$tl.hostval get]
	set ::otherdbport [expr {[$tl.portval get]+1}]
	set ::otherdbinst [$tl.instval get]
    set ::otherdbglobusport [$tl.globusportval get]
    
	if { [string is space $::otherdbinst] } {
	    set ::dbinst_list(Other) [list default]
	    UpdateInstMenu
	    set ::dbinst "default"
	} else {
	    set ::dbinst_list(Other) [list default $::otherdbinst]
	    UpdateInstMenu
	    set ::dbinst $::otherdbinst
	}
	destroy $tl
	update idletasks
    } tl ]
    button $tl.barea.cancel -text Cancel -command "destroy $tl"

    ;##- Insert the current values (if any) into the entry widgets
    if { [info exists ::otherdbhost] && ! [string is space $::otherdbhost] } {
	$tl.hostval insert end $::otherdbhost
	$tl.portval insert end [expr {$::otherdbport-1}]
	$tl.instval insert end $::otherdbinst
    } else {
	$tl.portval insert end "10000"
    }

    ;##- Bind the return key for convenience
    bind $tl.hostval <Return> "focus $tl.portval"
    bind $tl.portval <Return> "focus $tl.instval"
    bind $tl.instval <Return> "$tl.barea.ok invoke"

    ;##- Set up focus bindings to show the Ok button as the default button
    ;##- When appropriate
    bind $tl.instval <FocusIn> "$tl.barea.ok config -default active"
    bind $tl.instval <FocusOut> "$tl.barea.ok config -default normal"
    
    ;##- Lay out the widgets
    grid $tl.barea.ok $tl.barea.cancel
    grid $tl.hostlabel $tl.hostval - -sticky news
    grid $tl.portlabel $tl.portval - -sticky news
    grid $tl.globusportlabel $tl.globusportval - -sticky news
    grid $tl.instlabel $tl.instval $tl.instnote -sticky news
    grid $tl.barea -columnspan 3 -sticky ns
    grid columnconfigure $tl 1 -weight 1

    ;##- Set focus to the hostname entry widget
    focus $tl.hostval

    ;##- Grab the focus
    set oldfocus [focus]
    focus $tl
    update idletasks
    catch {tkwait visibility $tl}
    catch {grab $tl}

    ;##- Wait for the window to be destroyed
    tkwait window $tl

    ;##- Release the focus
    catch {grab release $tl}
    focus $oldfocus
    return
}

##=========================================================================
## Name: GetArbitrarySQL
##
## Description:
##   Routine to pop up a new window with a text area in which the user can
##   type an SQL command and then submit it.
## 
## Usage:
##   GetArbitrarySQL
##
## Comments:
##   Implements a "history" mechanism (with "Prev" and "Next" buttons, or 
##   using the up-arrow and down-arrow keys) which allows the user to
##   retrieve and modify previous queries.

proc GetArbitrarySQL {} {

    ;##- Create a new window for SQL input
    set tl [NewToplevel]
    wm title $tl "Arbitrary SQL input"

    ;##- Create some global variables specific to this arbitrary-SQL window
    set tlbase [string range $tl 1 end]
    global sqlCmd$tlbase history$tlbase histIndex$tlbase
    set sqlCmd$tlbase {}
    set history$tlbase {}
    set histIndex$tlbase self

    ;##- If there is a global command history list, copy it
    if { [info exists ::globalSqlHistory] } {
	set history$tlbase $::globalSqlHistory
    }

    if {$::winIcons} {
	;##- Also create an icon for this window
	NewToplevel ${tl}Icon -icon -width 48 -height 48 -highlightthickness 0
	label ${tl}Icon.bitmap -image sqlIcon
	pack ${tl}Icon.bitmap -side top -fill x
	wm iconwindow $tl ${tl}Icon
    }

    ;##- Set up widgets
    label $tl.label -text "Enter SQL query"

    scrollbar $tl.yscroll -command "$tl.text yview" -orient vertical
    text $tl.text -width 64 -height 10 -wrap word \
	    -yscrollcommand "$tl.yscroll set" -setgrid true

    frame $tl.buttons1

    button $tl.buttons1.clear -text "Clear" -pady 0 \
	    -command "$tl.text delete 0.0 end"

    ;##- Set up "prev" and "next" buttons for a history mechanism
    ;##- (both initially disabled)

    button $tl.buttons1.prev -text "Prev" -pady 0 -state disabled \
	    -command [ selsub {
	if { $histIndex$tlbase == "self" } {
	    ;##- Store the current SQL query
	    set sqlCmd$tlbase [$tl.text get 1.0 "end -1 chars"]
	    ;##- Switch to the last item in the history stack
	    set histIndex$tlbase [expr {[llength $history$tlbase]-1}]
	    $tl.text delete 0.0 end
	    $tl.text insert end [lindex $history$tlbase $histIndex$tlbase]
	    ;##- Enable the "Next" button
	    $tl.buttons1.next config -state normal
	} else {
	    ;##- Update the history index
	    incr histIndex$tlbase -1
	    ;##- Get the query out of the history list
	    $tl.text delete 0.0 end
	    $tl.text insert end [lindex $history$tlbase $histIndex$tlbase]
	}
	;##- If this is first item in the history list, disable "Prev" button
	if { $histIndex$tlbase == 0 } {
	    $tl.buttons1.prev config -state disabled
	}
    } tl tlbase ]

    button $tl.buttons1.next -text "Next" -pady 0 -state disabled \
	    -command [selsub {
	;##- Enable the "Prev" button
	if { $histIndex$tlbase == 0 } {
	    $tl.buttons1.prev config -state normal
	}
	incr histIndex$tlbase
	if { $histIndex$tlbase > [expr {[llength $history$tlbase]-1}] } {
	    set histIndex$tlbase "self"
	    $tl.text delete 0.0 end
	    $tl.text insert end $sqlCmd$tlbase
	    ;##- Disable the "Next" button
	    $tl.buttons1.next config -state disabled
	} else {
	    $tl.text delete 0.0 end
	    $tl.text insert end [lindex $history$tlbase $histIndex$tlbase]
	}
    } tl tlbase ]

    frame $tl.buttons2

    button $tl.buttons2.submit -text "Submit" \
	    -command [selsub {
	;##- Get the command from the text widget
	set origsqlCmd$tlbase [ $tl.text get 1.0 "end -1 chars" ]
	;##- Replace any whitespace character with a true space, and trim
	regsub -all {\s} [string trim $origsqlCmd$tlbase] " " sqlCmd$tlbase

	if { ! [string is space $sqlCmd$tlbase] } {
	    ;##- Execute the command.  Display method depends on whether
	    ;##- we are just counting rows
	    if { [regexp -nocase -- {^select\s+(distinct\s+)?count\(} \
		    $sqlCmd$tlbase] } {
		Db2Submit $sqlCmd$tlbase rowcount
	    } else {
		Db2Submit $sqlCmd$tlbase $tabledisptype
	    }

	    ;##- Store the current command in the history list for this
	    ;##- arbitrary-SQL window, as well as the global history list
	    lappend history$tlbase $origsqlCmd$tlbase
	    lappend ::globalSqlHistory $origsqlCmd$tlbase

	    unset origsqlCmd$tlbase
	}

	;##- Clear the text area
	$tl.text delete 0.0 end

	;##- Reset the history index and the states of the prev/next buttons
	set histIndex$tlbase self
	$tl.buttons1.prev config -state normal
	$tl.buttons1.next config -state disabled
    } tl tlbase tabledisptype ]

    button $tl.buttons2.close -text "Close" \
	    -command "unset sqlCmd$tlbase history$tlbase histIndex$tlbase;\
	    if {\[winfo exists ${tl}Icon\]} {destroy ${tl}Icon}; destroy $tl"

##    ;##- Bind the up and down arrow keys to the history buttons
##    bind $tl.text <Key-Up> "$tl.buttons1.prev invoke; break"
##    bind $tl.text <Key-Down> "$tl.buttons1.next invoke; break"
##
##    ;##- Bind the return key to the Submit button
##    bind $tl.text <Return> "$tl.buttons2.submit invoke; break"

    ;##- Lay out the widgets
    grid $tl.buttons1.clear $tl.buttons1.prev $tl.buttons1.next \
	    -padx 10 -pady 2
    grid $tl.buttons2.submit $tl.buttons2.close -padx 10 -pady 2

    grid $tl.label -sticky ns
    grid $tl.text $tl.yscroll -sticky news
    grid $tl.buttons1 -sticky news
    grid $tl.buttons2 -sticky news
    grid rowconfigure $tl 1 -weight 1
    grid columnconfigure $tl 0 -weight 1

    ;##- Finally, set up a button to raise the main guild window
    button $tl.raise -text "main" -font normhelv -padx 0 -pady 0 \
	    -command "switch -- \[wm state .\] \
	    normal {raise .} iconic {wm deiconify .}; focus ."
    place $tl.raise -in $tl -relx 1 -rely 1 -anchor se

    if { $::guildPatchStatus == "no_file" && \
	[CompareVersions $::guildVersion > $::guildrc(lastPatchVersion)] } {
	;##----- Eval entry for debugging purposes (at bottom)
	entry $tl.dbeval
	grid $tl.dbeval -sticky news
	bind $tl.dbeval <Return> "eval \[$tl.dbeval get\]"
    }

    ;##- Set focus to the text widget
    focus $tl.text

    return
}

##=========================================================================
## Name: TimeConverter
##
## Description:
##   Pops up a GUI window to convert to/from GPS time.
## 
## Usage:
##   TimeConverter
##
## Comments:

proc TimeConverter {} {

    ;##- Create a new window
    set tl [NewToplevel]
    wm title $tl "Time Converter"

    if {$::winIcons} {
	;##- Also create an icon for this window
	NewToplevel ${tl}Icon -icon -width 48 -height 48 -highlightthickness 0
	label ${tl}Icon.bitmap -image timeIcon
	pack ${tl}Icon.bitmap -side top -fill x
	wm iconwindow $tl ${tl}Icon
    }

    ;##- Set up widgets
    label $tl.label -text "GPS time, or any date/time string (default UTC):"

    entry $tl.entry -width 36

    label $tl.msg -text "" -foreground red

    ;##- Frame to contain all the output stuff
    frame $tl.out

    if { ! [regexp -nocase {(windows|macos|darwin)} $::tcl_platform(os)] } {
	set menu [tk_optionMenu $tl.out.zonemenu convertZone$tl \
		Local Central Pacific]
	$tl.out.zonemenu config -pady 0
    } else {
	label $tl.out.zonemenu -text "   Local:   "
	set ::convertZone$tl "Local"
    }
    entry $tl.out.zonedtext -width 26 -relief flat -highlightcolor $::bgColor \
	    -state $::entrydis
    bind $tl.out.zonedtext <Button> "focus %W"
    grid $tl.out.zonemenu $tl.out.zonedtext -sticky w

    label $tl.out.utclabel -text "     UTC:   "
    entry $tl.out.utctext -width 31 -relief flat -highlightcolor $::bgColor \
	    -state $::entrydis
    bind $tl.out.utctext <Button> "focus %W"
    grid $tl.out.utclabel $tl.out.utctext -sticky w

    label $tl.out.mjdlabel -text "     MJD:   "
    entry $tl.out.mjdtext -width 31 -relief flat -highlightcolor $::bgColor \
	    -state $::entrydis
    bind $tl.out.mjdtext <Button> "focus %W"
    grid $tl.out.mjdlabel $tl.out.mjdtext -sticky w

    label $tl.out.gpslabel -text "     GPS:   "
    entry $tl.out.gpstext -width 31 -relief flat -highlightcolor $::bgColor \
	    -state $::entrydis
    bind $tl.out.gpstext <Button> "focus %W"
    grid $tl.out.gpslabel $tl.out.gpstext -sticky w

    label $tl.caveat -text ""

    frame $tl.buttons

    button $tl.buttons.help -text "Help" -command ShowTimeConverterHelp

    button $tl.buttons.close -text "Close" \
	    -command "if {\[winfo exists ${tl}Icon\]} {destroy ${tl}Icon};\
	    destroy $tl"

    grid $tl.buttons.help $tl.buttons.close -padx 10 -pady 2

##    ;##- Insert "now" into the entry widget, and update fields
##    $tl.entry insert end "now"
##    $tl.entry select range 0 end
    set ::lastval$tl "INIT"
    UpdateTimeConverter $tl

    ;##- Bind any keystroke, or paste, to update the output fields
    bind $tl.entry <KeyRelease> "+ UpdateTimeConverter $tl"
    bind $tl.entry <<PasteSelection>> "UpdateTimeConverter $tl"
    ;##- Have to rearrange the bindtags list so that the paste (which
    ;##- is bound to the Entry class) occurs before UpdateTimeConverter!
    bindtags $tl.entry [list Entry $tl.entry $tl all]

    ;##- Set default timezone
    set ::convertZone$tl Local
    ;##- Set a callback so that the times are updated if user changes zone
    trace variable ::convertZone$tl w "UpdateTimeConverter $tl force"

    ;##- Lay out the widgets
    grid columnconfigure $tl.out 1 -weight 1

    pack $tl.label -anchor w
    pack $tl.entry -fill x -expand true
    pack $tl.msg -fill x -expand true
    pack $tl.out -fill x -expand true
    pack $tl.caveat
    pack $tl.buttons

    ;##- Finally, set up a button to raise the main guild window
    button $tl.raise -text "main" -font normhelv -padx 0 -pady 0 \
	    -command "switch -- \[wm state .\] \
	    normal {raise .} iconic {wm deiconify .}; focus ."
    place $tl.raise -in $tl -relx 1 -rely 1 -anchor se

    ;##- Set focus to the entry widget
    focus $tl.entry

    return
}

##=========================================================================
## Name: UpdateTimeConverter
##
## Description:
##   Updates the output fields in a TimeConverter window
## 
## Usage:
##   UpdateTimeConverter tl [force]
##
## Arguments:
##   tl -- Toplevel Tk widget, containing widgets to be updated
##   mode -- Equal to "looping" if this was called by an after event,
##             or equal to "::convertZone$tl" if from the user selecting
##             a new time zone from the pulldown menu
##   ignore1, ignore2 -- Dummy arguments (present when this routine
##             is called as the result of a variable trace)
##
## Comments:

proc UpdateTimeConverter { tl {mode ""} args } {

    ;##- Delete any pending 'after' event for looping
    if { [info exists ::looping$tl] } {
	after cancel [set ::looping$tl]
	unset ::looping$tl
    }

    ;##- Get the contents of the entry widget
    if {[catch {$tl.entry get} instring]} {
	;##- Widget no longer exists, so just return
	return
    }
    set instring [string trim $instring]

    ;##- Update fields
    if { [catch {HandleTimeString $instring} gpsstring] } {
	if {$gpsstring == "pre-1994"} {
	    set newmsg "Unreasonable GPS time (prior to 1994)"
	} elseif {$gpsstring == "post-2037"} {
	    set newmsg "Unreasonable GPS time (after 2037)"
	} elseif {[regexp {^That time does not occur} $gpsstring]} {
	    set newmsg $gpsstring
	} elseif {[regexp {^\d+$} $instring]} {
	    set newmsg "Invalid GPS time"
	} else {
	    set newmsg "Invalid date/time string"
	}
	set gps ""
    } else {
	set gps $gpsstring
	set newmsg ""
    }

    ;##- If the GPS time is the same as before, we don't have to update
    ;##- (unless "force" was specified)
    if { ! [string equal $gpsstring [set ::lastval$tl]] || $mode == "force" } {

	set ::lastval$tl $gpsstring

	set zoned ""
	set utc ""
	if { ! [catch {utcTime $gps} systime] } {

	    if {[info exists ::env(TZ)]} {
		set saveZone $::env(TZ)
	    } else {
		set saveZone ""
	    }

	    set tzChanged 0
	    switch [set ::convertZone$tl] {
		"Central" { set ::env(TZ) "CST6CDT" ; set tzChanged 1 }
		"Pacific" { set ::env(TZ) "PST8PDT" ; set tzChanged 1 }
	    }

	    if { [ catch {clock format $systime \
		    -format {%b %d, %Y  %H:%M:%S %Z} } zoned ] } {
		set zoned ""
	    }

	    ;##- Abbreviate verbose timezones
	    regsub {([A-Z])[a-z]+ (?:(S)tandard|(D)aylight) Time} $zoned \
		    {\1\2T} zoned

	    if { [ catch {clock format $systime \
		    -format {%b %d, %Y  %H:%M:%S UTC} -gmt 1} utc ] } {
		set utc ""
	    }

	    if { $tzChanged } {
		;##- Restore the original time zone
		if { $saveZone != "" } {
		    set ::env(TZ) $saveZone
		} else {
		    unset ::env(TZ)
		}
	    }

	}

	#-- Calculate MJD from UTC
	if { [string is space $utc] } {
	    set mjd ""
	} else {
	    set systime [clock scan $utc]
	    set mjd [format "%.5f" [expr {40587.0+($systime/86400.0)}] ]
	}

	catch {
	    $tl.msg config -text $newmsg
	    if { [regexp {^now} $instring] && ! [string is space $utc] } {
		$tl.caveat config -text \
			"(according to this computer)"
	    } else {
		$tl.caveat config -text ""
	    }

	    $tl.out.zonedtext config -state normal
	    $tl.out.zonedtext delete 0 end
	    $tl.out.zonedtext insert end $zoned
	    $tl.out.zonedtext config -state $::entrydis

	    $tl.out.utctext config -state normal
	    $tl.out.utctext delete 0 end
	    $tl.out.utctext insert end $utc
	    $tl.out.utctext config -state $::entrydis

	    $tl.out.mjdtext config -state normal
	    $tl.out.mjdtext delete 0 end
	    $tl.out.mjdtext insert end $mjd
	    $tl.out.mjdtext config -state $::entrydis

	    $tl.out.gpstext config -state normal
	    $tl.out.gpstext delete 0 end
	    $tl.out.gpstext insert end $gps
	    $tl.out.gpstext config -state $::entrydis
	}

    }

    ;##- If instring begins with "now", schedule this to be called again
    if { [regexp -nocase {^now} $instring] } {
	set ::looping$tl [after 330 "UpdateTimeConverter $tl loop"]
    }

    return
}

##=========================================================================
## Name: GetLogEntries
##
## Description:
##   Pops up a window to retrieve log entries from a past LDAS job
## 
## Usage:
##   GetLogEntries
##
## Comments:

proc GetLogEntries {} {

    ;##- Create a new window
    set tl [NewToplevel]
    wm title $tl "LDAS log entries"
    set tlbase [string range $tl 1 end]

    if {$::winIcons} {
	;##- Also create an icon for this window
	NewToplevel ${tl}Icon -icon -width 48 -height 48 -highlightthickness 0
	${tl}Icon config -highlightthickness 4 \
		-highlightcolor black -highlightbackground black
	label ${tl}Icon.bitmap -image jobIcon
	pack ${tl}Icon.bitmap -side top -fill x
	wm iconwindow $tl ${tl}Icon
    }

    ;##- Pulldown menu to select database server
    global dbname$tlbase
    set dbname$tlbase $::dbname
    frame $tl.db
    label $tl.db.text -text "Database server:"
    set menu [eval tk_optionMenu $tl.db.menu dbname$tlbase $::dbservers]
    $tl.db.menu config -pady 0
    pack $tl.db.text -side left
    pack $tl.db.menu -side left

    ;##- Entry widget
    frame $tl.job
    label $tl.job.text -text "Job number or name:"
    entry $tl.job.entry
    pack $tl.job.text -side left
    pack $tl.job.entry -side left -fill x -expand true

    ;##- Button area
    frame $tl.barea
    button $tl.barea.get -text "Get log entries" -default active \
	    -command "GetLogEntriesSubmit $tl"
    button $tl.barea.cancel -text "Cancel" -command \
	    "unset dbname$tlbase; \
	    if {\[winfo exists ${tl}Icon\]} {destroy ${tl}Icon};\
	    destroy $tl"
    pack $tl.barea.get -side left -padx 10 -pady 2
    pack $tl.barea.cancel -side left -padx 10 -pady 2

    ;##- Lay out everything
    pack $tl.db -side top -anchor w
    pack $tl.job -side top -anchor w
    pack $tl.barea -side bottom

    ;##- Set the focus to the entry widget and bind the Return key
    focus $tl.job.entry
    bind $tl.job.entry <Return> "$tl.barea.get invoke"

    ;##- Create a scrolled text widget to be used for the log output,
    ;##- but not yet mapped
    frame $tl.logs
    scrollbar $tl.logs.yscroll -orient vertical \
	    -command "$tl.logs.text yview"
    text $tl.logs.text -width 72 -height 15 -wrap word -setgrid false \
	    -yscrollcommand "$tl.logs.yscroll set"
    bind $tl.logs.text <Button> "focus %W"
    grid $tl.logs.text $tl.logs.yscroll -sticky news
    grid rowconfigure $tl.logs 0 -weight 1
    grid columnconfigure $tl.logs 0 -weight 1

    return
}

##=========================================================================
## Name: GetLogEntriesSubmit
##
## Description:
##   Submits an LDAS user command to retrieve log entries for a specified job
## 
## Usage:
##   GetLogEntriesSubmit $tl
##
## Comments:

proc GetLogEntriesSubmit { tl } {

    set tlbase [string range $tl 1 end]
    global dbname$tlbase

    ;##- Get the job ID
    set jobid [string trim [$tl.job.entry get]]
    if { [string is space $jobid] } {
	tk_messageBox -icon info -type ok -title "How to get log entries" \
		-parent $tl \
		-message "Enter EITHER a complete LDAS job ID (e.g.\
		'LDAS-DEV12345'; note this is case-sensitive)\
		OR just the numeric part (e.g. '12345')."
	return
    }

    wm title $tl "[set dbname$tlbase] job [$tl.job.entry get]"
    pack forget $tl.db $tl.job $tl.barea.get
    pack $tl.logs -side top -fill both -expand true
    $tl.logs.text insert 0.0 "Getting log entries..."
    $tl.logs.text config -state disabled
    $tl.barea.cancel config -text "Close"
    ManagerSubmit "getLogEntries -returnprotocol http://oldlog -query $jobid" \
	    [selsub {TCL catch {$tl.logs.text config -state normal};\
			 catch {html::callback $tl.logs.text _OUTPUT_};\
			 catch {$tl.logs.text config -state disabled} } tl ] \
	    -dbname [set dbname$tlbase]

    return
}


##=========================================================================
## Name: WatchJobs
##
## Description:
##   Pops up a window to watch LDAS jobs on the current server
## 
## Usage:
##   WatchJobs
##
## Comments:

proc WatchJobs {} {

    ;##- Create a new window
    set tl [NewToplevel]
    wm title $tl "LDAS jobs at $::dbname"
    set tlbase [string range $tl 1 end]

    if {$::winIcons} {
	;##- Also create an icon for this window
	NewToplevel ${tl}Icon -icon -width 48 -height 48 -highlightthickness 0
	label ${tl}Icon.bitmap -image jobsIcon
	pack ${tl}Icon.bitmap -side top -fill x
	wm iconwindow $tl ${tl}Icon
	wm iconname $tl $::dbname
    }

    ;##------ Create text widget for header
    text $tl.head -width 78 -height 1 -wrap none \
	    -font boldfont -setgrid true -relief flat
    set charwidth [font measure [$tl.head cget -font] X]

    ;##- Calculate tab spacing, and apply to text widget
    set tabstops {}
    foreach tab [list 18 31 53 73] {
	lappend tabstops [expr {$tab*[font measure normfont X]}]
    }
    $tl.head config -tabs $tabstops

    ;##- Insert the header info
    $tl.head insert end "LDAS job\tUser\tCommand\tCurrent API\tTotal time"
    $tl.head config -state disabled

    ;##------ Create a scrolled text widget
    text $tl.text -width 80 -height 12 -wrap none -font normfont \
	    -yscrollcommand "$tl.scroll set" -setgrid true
    $tl.text config -tabs $tabstops
    $tl.text insert end "Retrieving information about active jobs...\n"
    $tl.text config -state disabled

    scrollbar $tl.scroll -orient vertical -command "$tl.text yview"

    ;##- Set up some text tags
    $tl.text tag configure red -foreground red


    ;##------ Create some buttons
    frame $tl.buttons
    button $tl.buttons.close -text "Close" -font normfont \
	    -command "if {\[winfo exists ${tl}Icon\]} {destroy ${tl}Icon};\
	    destroy $tl"
    grid $tl.buttons.close -padx 10 -pady 2

    ;##------ Time stamp
    label $tl.time -text "" -font normfont

    ;##------ Now lay out the window
    grid $tl.head -sticky news
    grid $tl.text $tl.scroll -sticky news
    grid $tl.buttons -sticky ns
    grid rowconfigure $tl 1 -weight 1
    grid columnconfigure $tl 0 -weight 1
    place $tl.time -in $tl -relx 0 -rely 1 -anchor sw

    ;##- Finally, set up a button to raise the main guild window
    button $tl.raise -text "main" -font normhelv -padx 0 -pady 0 \
	    -command "switch -- \[wm state .\] \
	    normal {raise .} iconic {wm deiconify .}; focus ."
    place $tl.raise -in $tl -relx 1 -rely 1 -anchor se

    ;##------ Start the loop to update this window
    WatchJobsLoop $tl $::dbname

    ;##- If window was closed, just return
    if { ! [winfo exists $tl] } { return }

    ;##------ If the window is destroyed, stop the loop
    bind $tl <Destroy> "+ set cancelWatchJobs$tl 1"

    return
}


##=========================================================================
## Name: WatchJobsLoop
##

proc WatchJobsLoop { tl dbname } {

    ;##- See if we should cancel the loop
    if { [info exists ::cancelWatchJobs$tl] } {
	unset ::cancelWatchJobs$tl
	return
    }

    if { $dbname == "Other" } {
	set addr $::otherdbhost
    } else {
	set addr $::manager_ip($dbname)
    }

    set url "http://$addr/ldas_outgoing/jobs/activejobs.tcl"
    if { [catch {http::geturl $url -timeout 10000} httpvar] || \
	    [catch {upvar #0 $httpvar httpstate}] || \
	    $httpstate(status) != "ok" || \
	    [regexp -nocase {not found} $httpstate(http)] || \
	    ! [info exists httpstate(body)] || \
	    [regexp -nocase {<html>} $httpstate(body)] } {
	catch {http::cleanup $httpvar}
	set msg "http error at [clock format [clock seconds]]\
		while trying to retrieve\n$url\n"
    } else {
	if { ! [catch \
		{UpdateWatchJobs $tl $httpstate(body) [clock seconds]} msg] } {
	    set msg ""
	}
    }
    http::cleanup $httpvar

    if { ! [winfo exists $tl] } { return }

    if { $msg != "" } {
	;##- Put error message into window
	$tl.text config -state normal
	$tl.text insert end $msg red
	$tl.text config -state disabled
    }

    after 15000 WatchJobsLoop $tl $dbname
    return
}


##=========================================================================
## Name: UpdateWatchJobs

proc UpdateWatchJobs { tl jobinfo curtime } {
    if { ! [winfo exists $tl] } { return }

    $tl.text config -state normal
    $tl.text delete 0.0 end

    ;##- Make sure list is valid
    if { [catch {llength $jobinfo}] } {
	return -code error "Received incomplete job-status info from LDAS\
		at [clock format [clock seconds]]"
    }

    ;##- Insert lines for each job
    foreach {running pending} $jobinfo {
	set nrunning [llength $running]
	set iloop 0
	foreach jobinfolist [concat $running $pending] {
	    incr iloop
	    foreach {job command api user times} $jobinfolist { break }

	    ;##- Skip certain user commands
	    if { $command == "activeJobSummary" } { continue }

	    ;##- For dataPipeline commands, make the DSO name more compact
	    regsub {^dataPipeline\s*\(libldas(.+)\.so[\.\d]*\)} $command \
		    {\1 DSO} command

	    ;##- Massage the API and time information; convert times to integer
	    if { $iloop > $nrunning } {
		set apiinfo "(pending)"
		set tottime ""
	    } elseif { [regexp {^(\d+)[^:]*:(\d+)} $times \
		    match tottime apitime] } {
		set apiinfo "$api ($apitime s)"
		append tottime " s"
	    } else {
		set apiinfo $api
		regexp {\d+} $times times
		set tottime "$times s"
	    }

	    ;##- Insert line into the text widget
	    $tl.text insert end "$job\t$user\t$command\t$apiinfo\t$tottime\n"

	}
	break
    }

    ;##- If list was truncated, say so
    if { [llength $jobinfo] >= 3 } {
	set queuelen_msg [lindex $jobinfo 2]
	regexp {\d+} $queuelen_msg njobs
	if { [string length $queuelen_msg] } {
	    $tl.text insert end "List has been truncated; $njobs jobs currently are pending\n"
	}
    }

    $tl.text config -state disabled

    ;##- Format the current time
    set curtime [clock format $curtime -format "%T %Z"]

    ;##- Abbreviate verbose timezones
    regsub {([A-Z])[a-z]+ (?:(S)tandard|(D)aylight) Time} $curtime \
	    {\1\2T} curtime

    $tl.time config -text "at $curtime"

    return
}


##=========================================================================
## Name: LDASUserCommand
##
## Description:
##   Routine to pop up a new window with entry fields for manager request
## 
## Usage:
##   LDASUserCommand

proc LDASUserCommand {} {

    ;##- Create a new window for input
    set tl [NewToplevel]
    wm title $tl "LDAS User Command"

    ;##- Create some global variables specific to this window
    set tlbase [string range $tl 1 end]
    global dgetCmd$tlbase dgetFile$tlbase history$tlbase histIndex$tlbase \
	    jobtype$tlbase displaytype$tlbase email$tlbase \
	    jobdir$tlbase file$tlbase
    set dgetCmd$tlbase {}
    set dgetFile$tlbase {}
    set history$tlbase {}   ;##- List of {command,filename} pairs
    set histIndex$tlbase self

    if { [info exists ::guildrc(defaultJobtype)] } {
	set jobtype$tlbase $::guildrc(defaultJobtype)
    } else {
	set jobtype$tlbase fg
    }

    if { [info exists ::guildrc(defaultCmdDisplay)] } {
	set displaytype$tlbase $::guildrc(defaultCmdDisplay)
    } else {
	set displaytype$tlbase file
    }

    if { [info exists ::guildrc(defaultEmail)] } {
	set email$tlbase $::guildrc(defaultEmail)
    } else {
	set email$tlbase ""
    }

    if { [info exists ::guildrc(defaultJobDir)] } {
	set jobdir$tlbase $::guildrc(defaultJobDir)
    } else {
	set jobdir$tlbase [pwd]
    }

    set file$tlbase ""

    ;##- If there is a global command history list, copy it
    if { [info exists ::globalCmdHistory] } {
	;##- Note that ::globalCmdHistory is a simple list of LDAS commands,
	;##- while history$tlbase is a list of {command,filename} pairs
	foreach cmd $::globalCmdHistory {
	    lappend history$tlbase [list $cmd ""]
	}
    }

    if {$::winIcons} {
	;##- Also create an icon for this window
	NewToplevel ${tl}Icon -icon -width 48 -height 48 -highlightthickness 0
	label ${tl}Icon.bitmap -image ldascmdIcon
	pack ${tl}Icon.bitmap -side top -fill x
	wm iconwindow $tl ${tl}Icon
    }

    ;##- Lay out the "header" area

    frame $tl.head

    label $tl.head.label -text "LDAS user command:" -font boldfont


    button $tl.head.clear -text "Clear" -pady 0 \
	    -command "$tl.cmd.text delete 0.0 end; set file$tlbase {}"

    ;##- Set up "prev" and "next" buttons for a history mechanism
    ;##- (both initially disabled)

    button $tl.head.prev -text "Prev" -pady 0 \
	    -command [ selsub {
	if { $histIndex$tlbase == "self" } {
	    ;##- Store the current command and filename
	    set dgetCmd$tlbase [$tl.cmd.text get 1.0 "end -1 chars"]
	    set dgetFile$tlbase $file$tlbase
	    ;##- Switch to the last item in the history stack
	    set histIndex$tlbase [expr {[llength $history$tlbase]-1}]
	    ;##- Enable the "Next" button
	    $tl.head.next config -state normal
	} else {
	    ;##- Update the history index
	    incr histIndex$tlbase -1
	}

	;##- Get the query out of the history list
	$tl.cmd.text delete 0.0 end
	$tl.cmd.text insert end \
		[lindex [lindex $history$tlbase $histIndex$tlbase] 0]
	set file$tlbase \
		[lindex [lindex $history$tlbase $histIndex$tlbase] 1]
	$tl.file.entry xview end

	;##- If this is first item in the history list, disable "Prev" button
	if { $histIndex$tlbase == 0 } {
	    $tl.head.prev config -state disabled
	}
    } tl tlbase ]

    ;##- If the history list is empty, disable the "Prev" button
    if { [llength [set history$tlbase]] == 0 } {
	$tl.head.prev config -state disabled
    }

    button $tl.head.next -text "Next" -pady 0 -state disabled \
	    -command [selsub {
	;##- Enable the "Prev" button
	if { $histIndex$tlbase == 0 } {
	    $tl.head.prev config -state normal
	}
	incr histIndex$tlbase
	if { $histIndex$tlbase > [expr {[llength $history$tlbase]-1}] } {
	    set histIndex$tlbase "self"
	    $tl.cmd.text delete 0.0 end
	    $tl.cmd.text insert end $dgetCmd$tlbase
	    set file$tlbase $dgetFile$tlbase
	    $tl.file.entry xview end
	    ;##- Disable the "Next" button
	    $tl.head.next config -state disabled
	} else {
	    $tl.cmd.text delete 0.0 end
	    $tl.cmd.text insert end \
		    [lindex [lindex $history$tlbase $histIndex$tlbase] 0]
	    set file$tlbase \
		    [lindex [lindex $history$tlbase $histIndex$tlbase] 1]
	    $tl.file.entry xview end
	}
    } tl tlbase ]

    pack $tl.head.label -side left -anchor w -expand true
    pack $tl.head.next -side right
    pack $tl.head.prev -side right
    pack $tl.head.clear -side right

    ;##- Lay out the user command area

    frame $tl.cmd
    scrollbar $tl.cmd.yscroll -command "$tl.cmd.text yview" -orient vertical
    text $tl.cmd.text -width 64 -height 6 -wrap word \
	    -yscrollcommand "$tl.cmd.yscroll set" -setgrid true
    grid $tl.cmd.text $tl.cmd.yscroll -sticky news
    grid rowconfigure $tl.cmd 0 -weight 1
    grid columnconfigure $tl.cmd 0 -weight 1

    ;##- Lay out the "file" area

    frame $tl.file

    label $tl.file.label -text "File:"

    entry $tl.file.entry -textvariable file$tlbase \
	    -relief solid -borderwidth 1 \
	    -highlightcolor $::bgColor -state $::entrydis
    bind $tl.file.entry <Button> "focus %W"

    button $tl.file.open -text "Open..." -font normhelv -padx 0 -pady 0 \
	    -command [selsub {
	set tempfile$tlbase [tk_getOpenFile -defaultextension ".job" \
		-initialdir $jobdir$tlbase -filetypes [list \
		{{LDAS jobs} {.job}} {{Tcl scripts} {.tcl}} {{All files} *} ] \
		-parent $tl -title "Load LDAS user command from file"]
	if { ! [string is space $tempfile$tlbase] } {
	    if { [catch {open $tempfile$tlbase r} tempfid] } {
		set ignore [ tk_messageBox -type ok -icon error -parent $tl \
			-title "Error loading LDAS user command from file" \
			-message "Error loading LDAS user command from file:\
			$tempfid" ]
	    } else {
		$tl.cmd.text delete 0.0 end
		set temptext [read $tempfid]

###		;##- If necessary, try to strip out bare LDAS command
###		regexp {^\s*ldasJob\s+{\s*-name\s+\S+\s+-password\s+\S+\s+-email\s+\S+\s*}\s+(\S.+)$} $temptext match temptext

		$tl.cmd.text insert end $temptext
		unset temptext
		close $tempfid

		;##- Insert filename into "File" area entry widget
		set file$tlbase $tempfile$tlbase
		$tl.file.entry xview end

		;##- Update the default job directory, and the global default
		set jobdir$tlbase [file dirname $tempfile$tlbase]
		set ::guildrc(defaultJobDir) $jobdir$tlbase
	    }
	}
    } tl tlbase]

    button $tl.file.saveas -text "Save As..." -font normhelv \
	    -padx 0 -pady 0 -command [selsub {
	set tempfile$tlbase [tk_getSaveFile -defaultextension ".job" \
		-initialdir $jobdir$tlbase -filetypes [list \
		{{LDAS jobs} {.job}} {{Tcl scripts} {.tcl}} {{All files} *} ] \
		-parent $tl -title "Save LDAS user command to file"]
	if { ! [string is space $tempfile$tlbase] } {
	    if { [catch {open $tempfile$tlbase w} tempfid] } {
		set ignore [ tk_messageBox -type ok -icon error -parent $tl \
			-title "Error saving LDAS user command to file" \
			-message "Error saving LDAS user command to file:\
			$tempfid" ]
	    } else {
		puts -nonewline $tempfid [$tl.cmd.text get 1.0 "end -1 chars"]
		close $tempfid

		;##- If this file appears in the history list, mark other
		;##- instances as "old"
		set temphistory$tlbase {}
		foreach cmdAndFile $history$tlbase {
		    if { [regexp "^($tempfile$tlbase)( \\(modified\\))?$" \
			    [lindex $cmdAndFile 1] match temp1 temp2] } {
			set cmdAndFile [lreplace $cmdAndFile 1 1 \
				"$temp1 (old)$temp2"]
		    }
		    lappend temphistory$tlbase $cmdAndFile
		}
		set history$tlbase $temphistory$tlbase
		unset temphistory$tlbase

		;##- Insert filename into "File" area entry widget
		set file$tlbase $tempfile$tlbase
		$tl.file.entry xview end

		;##- Update the default job directory, and the global default
		set jobdir$tlbase [file dirname $tempfile$tlbase]
		set ::guildrc(defaultJobDir) $jobdir$tlbase
	    }
	}
    } tl tlbase]

    pack $tl.file.label -side left
    pack $tl.file.entry -side left -fill x -expand true
    pack $tl.file.saveas -side right
    pack $tl.file.open -side right

    ;##- Lay out options area

    label $tl.typehead -text "Job type:" -font boldfont

    frame $tl.fg
    radiobutton $tl.fg.but -variable ::jobtype$tlbase -value fg -pady 0 \
	    -text "Foreground" \
	    -command "$tl.fg.text config -foreground black;\
	    $tl.fg.dlyes config -state normal;\
	    $tl.fg.dlno config -state normal;\
	    $tl.bg.text config -foreground gray50;\
	    $tl.bg.email config -foreground gray50;\
	    set ::guildrc(defaultJobtype) \[set ::jobtype$tlbase\]"
    label $tl.fg.text -text "-- Automatically download output? "
    radiobutton $tl.fg.dlyes -text "Yes " -pady 0 \
	    -variable ::displaytype$tlbase -value file -command \
	    "set ::guildrc(defaultCmdDisplay) \[set ::displaytype$tlbase\]"
    radiobutton $tl.fg.dlno -text "No" -pady 0 \
	    -variable ::displaytype$tlbase -value jobmessage -command \
	    "set ::guildrc(defaultCmdDisplay) \[set ::displaytype$tlbase\]"
    pack $tl.fg.but $tl.fg.text $tl.fg.dlyes $tl.fg.dlno -side left

    frame $tl.bg
    radiobutton $tl.bg.but -variable ::jobtype$tlbase -value bg -pady 0 \
	    -text "Background" \
	    -command "$tl.fg.text config -foreground gray50;\
	    $tl.fg.dlyes config -state disabled;\
	    $tl.fg.dlno config -state disabled;\
	    $tl.bg.text config -foreground black;\
	    $tl.bg.email config -foreground black;\
	    set ::guildrc(defaultJobtype) \[set ::jobtype$tlbase\]"
    label $tl.bg.text -text "-- email to:"
    entry $tl.bg.email -textvariable email$tlbase
    pack $tl.bg.but $tl.bg.text -side left
    pack $tl.bg.email -side left -fill x -expand true

	;## cannot use email for results with globus sockets
    if	{ $::ACCESS_METHOD == "X509 proxy" } {
    	$tl.bg.but config -state disabled 
        set ::jobtype$tlbase fg
    }
    
    ;##- Disable buttons or email entry, as appropriate
    if { [set ::jobtype$tlbase] == "fg" || \
	     $::ACCESS_METHOD == "X509 proxy" } {
	$tl.bg.text config -foreground gray50
	$tl.bg.email config -foreground gray50
    } else {
	$tl.fg.text config -foreground gray50
	$tl.fg.dlyes config -state disabled
	$tl.fg.dlno config -state disabled
    }

    ;##- Set up bindings so that any change to the email address causes
    ;##- the global default to be updated
    bind $tl.bg.email <Key> \
	    "after 0 set ::guildrc(defaultEmail) \\\[set ::email$tlbase\\\]"
    bind $tl.bg.email <Button-2> \
	    "after 0 set ::guildrc(defaultEmail) \\\[set ::email$tlbase\\\]"

    ;##- Lay out buttons

    frame $tl.buttons

    button $tl.buttons.submit -text "Submit" \
	    -command "LDASUserCommandSubmit $tl"

    button $tl.buttons.help -text "Help" \
	    -command ShowLdasCmdHelp

    button $tl.buttons.close -text "Close" \
	    -command "unset dgetCmd$tlbase dgetFile$tlbase\
	    history$tlbase histIndex$tlbase\
	    jobtype$tlbase displaytype$tlbase email$tlbase\
	    jobdir$tlbase file$tlbase;\
	    if {\[winfo exists ${tl}Icon\]} {destroy ${tl}Icon}; destroy $tl"

    grid $tl.buttons.submit $tl.buttons.help $tl.buttons.close \
	    -padx 10 -pady 2

    ;##- Lay out the frames
    pack $tl.buttons -side bottom -fill x
    pack $tl.bg -side bottom -fill x
    pack $tl.fg -side bottom -fill x
    pack $tl.typehead -side bottom -anchor w
    pack $tl.file -side bottom -fill x
    pack $tl.head -side top -fill x
    pack $tl.cmd -side top -fill both -expand true

    ;##- Finally, set up a button to raise the main guild window
    button $tl.raise -text "main" -font normhelv -padx 0 -pady 0 \
	    -command "switch -- \[wm state .\] \
	    normal {raise .} iconic {wm deiconify .}; focus ."
    place $tl.raise -in $tl -relx 1 -rely 1 -anchor se

    ;##- Set up bindings to detect any modification of the command text
    set addModifyCmd [selsub {
	if {[KeyModifiesText %K %A]} {
	    if { ! [string is space $file$tlbase] \
		    && ! [string match {* (modified)} $file$tlbase] } {
		append file$tlbase " (modified)"
		$tl.file.entry xview end
	    }
	}
    } tl tlbase] 
    bind $tl.cmd.text <Key> $addModifyCmd
    bind $tl.cmd.text <Button-2> $addModifyCmd

    ;##- Set focus to the text widget
    focus $tl.cmd.text

    return
}


##=========================================================================
## Name: KeyModifiesText
##
## Description:
##   Returns 1 if the key just pressed modifies the contents of a text
##   widget, e.g. if it is an alphanumeric key or BackSpace or Delete.
##   Returns 0 otherwise.
## 
## Parameters:
##   keysym -- keysym of the key just pressed (%K for the event)
##   asym -- printing character for the key just pressed (%A for the event)
##
## Usage:
##   KeyModifiesText keysym asym
##
## Comments:
##   Used from a binding in LDASUserCommand

proc KeyModifiesText { keysym asym } {
###    puts "keysym is $keysym, asym is $asym"
    if { $keysym=="BackSpace" || $keysym=="Delete" } { return 1 }
    if { [string length $asym] > 0 } {
	return 1
    } else {
	return 0
    }

    return
}


##=========================================================================
## Name: LDASUserCommandSubmit
##
## Description:
##   Routine which gets called when you press the "Submit" button in the
##   LDAS User Command window
##
## Argument:
##   tl - toplevel widget ID for LDAS User Command window
##
## Usage:
##   LDASUserCommandSubmit tl

proc LDASUserCommandSubmit { tl } {

    set tlbase [string range $tl 1 end]

    ;##- Get the command from the text widget
    set origcmd [ $tl.cmd.text get 1.0 "end -1 chars" ]

    ;##- Strip out any comments
    regsub -all {\s*#[^\n]*} $origcmd {} cmd

    ;##- Replace any whitespace character with a true space, and trim
    regsub -all {\s} [string trim $cmd] " " cmd

    ;##- If the command is enclosed in braces, trim them
    regexp {^{\s*(.+)\s*}$} $cmd match cmd

    if { [string is space $cmd] } { return }

    ;##- Check if command format seems right
    if { [regexp {^ldasJob } $cmd] } {
	BigMessageBox -icon error \
			-title "Error in LDAS command" \
			-message "When submitting an LDAS user command\
			using guild, you should NOT include the initial\
			'ldasJob' or the name/password/email information."
	return
    }

    ;##- Execute the command.
    if { [set ::jobtype$tlbase] == "fg" } {
	ManagerSubmit $cmd [set ::displaytype$tlbase]
    } else {
	if { [regexp {^\S+@\S+$} [set ::email$tlbase]] } {
	    ManagerSubmit $cmd [set ::displaytype$tlbase] \
		    -email [set ::email$tlbase]
	} else {
	    set ignore [ tk_messageBox -type ok -icon error -parent $tl \
		    -title "Invalid email address" \
		    -message "You must enter a valid email address\
		    of the form user@host" ]
	    return
	}
    }

    ;##- Store the current command in the history list for this
    ;##- arbitrary-SQL window, as well as the global history list
    lappend ::history$tlbase [list $origcmd [set ::file$tlbase]]
    lappend ::globalCmdHistory $origcmd

    ;##- Clear the text area and the filename
    $tl.cmd.text delete 0.0 end
    set ::file$tlbase {}

    ;##- Reset history index and the states of the prev/next buttons
    set ::histIndex$tlbase self
    $tl.head.prev config -state normal
    $tl.head.next config -state disabled

    return
}


##=========================================================================
## Name: BuildQueryDialog
##
## Description:
##   Main routine to construct a "build query" dialog, with buttons and
##   entry widgets to allow the user to determine the query.
##
## Parameters:
##   table -- Database table for which query will be built
##   ?options? -- See Usage and Comments
##
## Usage:
##   BuildQueryDialog table ?-preset var=value? ?-preset var=value? ...
##
## Comments:
##   This routine does not contain any table-specific code, but rather
##   passes the table name to SetupQualifiers to set up the table-specific
##   stuff (in a frame in a scrollable canvas).
##
##   Any "-preset" option is used to initialize the appropriate
##   qualifier section in the query dialog.  For example, if called with 
##   "-preset start_time=632451347", then the start_time qualifier is
##   initially set to be required to be equal to 632451347.  There can be
##   more than one "-preset"; they are processed sequentially.
##
##   The "Refresh & Submit" calls BuildQuery to build the SQL query
##   according to the current settings and insert the query into the text
##   widget near the bottom of the dialog, then calls Db2Submit to
##   execute the query and display the results.

proc BuildQueryDialog { table args } {

    ;##- Check options
    set presets {}
    foreach { opt optval } $args {
	switch -- $opt {
	    -preset { lappend presets $optval }
	}
    }

    ;##- Convert table name to uppercase
    set table [string toupper $table]

    ;##- Create a new window for input
    set tl [NewToplevel]
    wm title $tl "Build query for table $table"
    wm iconname $tl $table

    if {$::winIcons} {
	;##- Also create an icon for this window
	NewToplevel ${tl}Icon -icon -width 48 -height 48 -highlightthickness 0
	label ${tl}Icon.bitmap -image buildqueryIcon
	pack ${tl}Icon.bitmap -side top -fill x
	wm iconwindow $tl ${tl}Icon
	wm iconname $tl $table
    }

    ;##- Declare some global variables specific to this dialog
    set tlbase [string range $tl 1 end]
    global sqlCmdColumns$tlbase checkbutton$tlbase comptype$tlbase \
	    distinct$tlbase

    ;##----------- Label area (at top)

    frame $tl.label
    label $tl.label.label1 -text "Build query for table " -padx 0 -pady 10
    label $tl.label.label2 -text "$table   " \
	    -font boldfont -foreground blue -padx 0 -pady 10
    pack $tl.label.label1 $tl.label.label2 $tl.label -side left
    pack $tl.label -side top

    ;##----------- Button area (at bottom)

    frame $tl.barea

    button $tl.barea.submit -text "Refresh & Submit" \
	    -command [selsub {
	BuildQuery $tl $table
	set sqlCmd [ $tl.query.text get 1.0 "end -1 chars" ]
	if { $sqlCmd != "" } {
	    lappend ::globalSqlHistory $sqlCmd

	    ;##- Check whether the query is just designed to count the
	    ;##- number of matching records.
	    if { [string equal -nocase [string range $sqlCmd 0 19] \
		    "select count(*) from"] || \
		    [string equal -nocase [string range $sqlCmd 0 28] \
		    "select distinct count(*) from"] } {
		Db2Submit $sqlCmd rowcount
	    } else {
		Db2Submit $sqlCmd $tabledisptype
	    }
	}
    } tl table tabledisptype ]

    button $tl.barea.help -text "Help" -command ShowQueryHelp
    button $tl.barea.close -text "Close" \
	    -command "if {\[winfo exists ${tl}Icon\]} {destroy ${tl}Icon};\
	    destroy $tl"
    grid $tl.barea.submit $tl.barea.help $tl.barea.close -padx 10 -pady 2
    pack $tl.barea -side bottom -fill x

    ;##----------- Query area (at bottom)

    frame $tl.query
    scrollbar $tl.query.yscroll -orient vertical \
	    -command "$tl.query.text yview"
    text $tl.query.text -width 64 -height 5 -wrap word -state disabled \
	    -yscrollcommand "$tl.query.yscroll set"
    bind $tl.query.text <Button> "focus %W"

    grid $tl.query.text $tl.query.yscroll -sticky news
    grid columnconfigure $tl.query 0 -weight 1
    grid $tl.query -sticky news
    pack $tl.query -side bottom -fill x

    ;##----- Heading above query area
    frame $tl.queryhead
    label $tl.queryhead.label -text "Built SQL query:   " -font boldfont
    button $tl.queryhead.refresh -text "Refresh" -pady 0 -default active \
	    -command "BuildQuery $tl $table"
    pack $tl.queryhead.label $tl.queryhead.refresh -side left
    pack $tl.queryhead -side bottom -fill x

    ;##- Bind the Return key to the Refresh button
    bind $tl <Return> "$tl.queryhead.refresh invoke"

    ;##----- Empty frame to put some space above the query area
    frame $tl.querypad -height 12
    pack $tl.querypad -side bottom -fill x

    ;##----------- Column-select area

    frame $tl.colsel
    frame $tl.colsel.group
    label $tl.colsel.label -text "Columns:" -font boldfont
    set sqlCmdColumns$tlbase "all"
    radiobutton $tl.colsel.all -text "All" -pady 0 \
	    -variable sqlCmdColumns$tlbase -value "all" \
	    -command "$tl.colsel.entry config -foreground gray50;\
	    $tl.colsel.group.by config -foreground gray50;\
	    $tl.orderby.entry config -foreground black;\
	    $tl.maxfetch.entry config -foreground black"
    radiobutton $tl.colsel.sel -text "Selected:" -pady 0 \
	    -variable sqlCmdColumns$tlbase -value "sel" \
	    -command "$tl.colsel.entry config -foreground black;\
	    $tl.colsel.group.by config -foreground gray50;\
	    $tl.orderby.entry config -foreground black;\
	    $tl.maxfetch.entry config -foreground black"
    radiobutton $tl.colsel.count -pady 0 \
	    -text "Just count number of matching records" \
	    -variable sqlCmdColumns$tlbase -value "count" \
	    -command "$tl.colsel.entry config -foreground gray50;\
	    $tl.colsel.group.by config -foreground gray50;\
	    $tl.orderby.entry config -foreground gray50;\
	    $tl.maxfetch.entry config -foreground gray50"
    radiobutton $tl.colsel.group.btn -pady 0 \
	    -text "Count, grouping by column(s):" \
	    -variable sqlCmdColumns$tlbase -value "group" \
	    -command "$tl.colsel.entry config -foreground gray50;\
	    $tl.colsel.group.by config -foreground black;\
	    $tl.orderby.entry config -foreground gray50;\
	    $tl.maxfetch.entry config -foreground black"

    frame $tl.colsel.buttons
    button $tl.colsel.buttons.list -text "List" -pady 0 \
	    -command [selsub {
	set tempListDisp [Db2Submit "SELECT colname FROM syscat.columns\
		WHERE tabname='$table'\
		AND tabschema NOT IN ('SYSCAT', 'SYSIBM', 'SYSSTAT')\
		ORDER BY colno" listbox \
		-description "Columns in table\n\"$table\"" \
		-lblinks {$tl.colsel.entry $tl.colsel.sel}];
    } tl table ]

    button $tl.colsel.buttons.details -text "Details" -pady 0 -command \
	    "Db2Submit \"SELECT\
	    colname,typename,length,codepage,default,nulls,remarks\
	    FROM syscat.columns WHERE tabname='$table' ORDER BY colno\"\
	    scrolledtable"
    pack $tl.colsel.buttons.list $tl.colsel.buttons.details -side left

    entry $tl.colsel.entry
    entry $tl.colsel.group.by

    ;##- Set up bindings so that the entry widget can change the radio buttons
    bind $tl.colsel.entry <Key> \
	"if {\[KeyModifiesEntry %K %A\]} {$tl.colsel.sel invoke}"
    bind $tl.colsel.entry <Button-2> "$tl.colsel.sel invoke"

    bind $tl.colsel.entry <KeyRelease-BackSpace> \
	    "if {\[$tl.colsel.entry get\] == {}} {$tl.colsel.all invoke}"
    bind $tl.colsel.entry <KeyRelease-Delete> \
	    "if {\[$tl.colsel.entry get\] == {}} {$tl.colsel.all invoke}"
    bind $tl.colsel.entry <Control-KeyRelease-d> \
	    "if {\[$tl.colsel.entry get\] == {}} {$tl.colsel.all invoke}"

    ;##- Set up similar bindings for the groupby entry widget
    bind $tl.colsel.group.by <Key> \
	"if {\[KeyModifiesEntry %K %A\]} {$tl.colsel.group.btn invoke}"
    bind $tl.colsel.group.by <Button-2> "$tl.colsel.group.btn invoke"

    bind $tl.colsel.group.by <KeyRelease-BackSpace> \
	    "if {\[$tl.colsel.group.by get\] == {}} {$tl.colsel.count invoke}"
    bind $tl.colsel.group.by <KeyRelease-Delete> \
	    "if {\[$tl.colsel.group.by get\] == {}} {$tl.colsel.count invoke}"
    bind $tl.colsel.group.by <Control-KeyRelease-d> \
	    "if {\[$tl.colsel.group.by get\] == {}} {$tl.colsel.count invoke}"

    ;##- Lay out the column-selection area
    grid $tl.colsel.label -row 0 -column 0 -sticky w
    grid $tl.colsel.all -row 0 -column 1 -sticky w
    grid $tl.colsel.buttons -row 0 -column 2 -sticky w
    grid $tl.colsel.sel -row 1 -column 1 -sticky w
    grid $tl.colsel.entry -row 1 -column 2 -columnspan 2 -sticky ew
    grid $tl.colsel.count -row 2 -column 1 -columnspan 3 -sticky w
###    grid $tl.colsel.group.btn -row 3 -column 1 -columnspan 2 -sticky w
###    grid $tl.colsel.group.by -row 3 -column 3 -sticky ew
    pack $tl.colsel.group.btn -side left
    pack $tl.colsel.group.by -side left -fill x -expand true
    grid $tl.colsel.group -row 3 -column 1 -columnspan 3 -sticky ew
    grid columnconfigure $tl.colsel 3 -weight 1
    pack $tl.colsel -side top -fill x

    ;##----------- Order-by area

    ;##- Create a label and an entry widget
    frame $tl.orderby
    label $tl.orderby.label -text "Order by column(s):" -font boldfont
    entry $tl.orderby.entry

    set menu [tk_optionMenu $tl.orderby.dir orderdir$tlbase \
	    "ascending" "descending"]
    $menu entryconfigure 0 -command "$tl.queryhead.refresh invoke"
    $menu entryconfigure 1 -command "$tl.queryhead.refresh invoke"

    ;##- Lay out the order-by area
    pack $tl.orderby.label -side left
    pack $tl.orderby.dir -side right
    pack $tl.orderby.entry -side right -fill x -expand true
    pack $tl.orderby -side top -fill x

    ;##----------- Max-fetch area

    ;##- Create a label and an entry widget
    frame $tl.maxfetch
    label $tl.maxfetch.label -text "Maximum number of records to fetch:" \
	    -font boldfont
    entry $tl.maxfetch.entry -width 8
    label $tl.maxfetch.note -text " (LDAS max: 10000)"

    ;##- Lay out the max-fetch area
    pack $tl.maxfetch.label -side left
    pack $tl.maxfetch.entry -side left
    pack $tl.maxfetch.note -side left
    pack $tl.maxfetch -side top -fill x

    ;##----------- Qualifiers area

    ;##----- Empty frame to put some space above the qualifiers area
    frame $tl.qualspad -height 6
    pack $tl.qualspad -side top -fill x

    ;##----- Heading above qualifiers area

    ;##- "Qualifiers:" label
    frame $tl.qualshead
    label $tl.qualshead.label -text "Qualifiers:" -font boldfont
    pack $tl.qualshead.label -side left

    ;##- Text around option menu determining whether text comparisons
    ;##- are case-sensitive
    label $tl.qualshead.casetext1 -text "Text comparisons"
    label $tl.qualshead.casetext2 -text "case-sensitive"

    ;##- Option menu    
    global casecomp$tlbase
    set casecomp$tlbase "are"
    set menu [tk_optionMenu $tl.qualshead.casemenu casecomp$tlbase \
	    "are" "are not"]
    $tl.qualshead.casemenu config -pady 0

    ;##- Lay out the case-sensitivity stuff
    pack $tl.qualshead.casetext2 -side right
    pack $tl.qualshead.casemenu -side right
    pack $tl.qualshead.casetext1 -side right

    pack $tl.qualshead -side top -fill x

    ;##----- Main part of qualifiers area

    ;##- Create a scrolled canvas in a frame ($tl.quals)
    frame $tl.quals -relief solid -borderwidth 2
    canvas $tl.quals.canvas -yscrollcommand "$tl.quals.yscroll set"
    scrollbar $tl.quals.yscroll -orient vertical \
	    -command "$tl.quals.canvas yview"
    pack $tl.quals.yscroll -side right -fill y
    pack $tl.quals.canvas -side left -fill both -expand true
    pack $tl.quals -side top -fill both -expand true

    ;##- Create another frame ($tl.quals.canvas.f) to hold all qualifiers,
    ;##- and position it on the canvas
    set f [frame $tl.quals.canvas.f -borderwidth 0]
    set canvastag [$tl.quals.canvas create window 0 0 -anchor nw -window $f]

    ;##- Now add qualifier widgets appropriate for this table
    SetupQualifiers $f $table

    ;##- Wait for the frame to be mapped, then look up its size
    catch {tkwait visibility $tl.quals.canvas.f}
    set width [winfo reqwidth $f]
    set height [winfo reqheight $f]
    $tl.quals.canvas config -scrollregion "0 0 $width $height"
    if { $height > 200 } { set height 200 }
    $tl.quals.canvas config -height $height

    ;##- Set up a binding so that if the canvas size changes, then the width
    ;##- of the frame it contains is updated
    bind $tl.quals.canvas <Configure> \
    	    "$tl.quals.canvas itemconfigure $canvastag \
	    -width \[winfo width $tl.quals.canvas\]"

    ;##- Finally, set up a button to raise the main guild window
    button $tl.raise -text "main" -font normhelv -padx 0 -pady 0 \
	    -command "switch -- \[wm state .\] \
	    normal {raise .} iconic {wm deiconify .}; focus ."
    place $tl.raise -in $tl -relx 1 -rely 1 -anchor se

    ;##----------- Done setting up widgets

    ;##- Apply any presets (must be of the form "varname=value")
    foreach preset $presets {
###	puts "Applying preset $preset"
	set charpos [string first "=" $preset]
	if {$charpos > -1} {
	    ;##- Parse this to get the variable name and value
	    set varname [string tolower \
		    [string range $preset 0 [expr {$charpos-1}]]]
	    set value [string range $preset [expr {$charpos+1}] end]

	    ;##- Insert the value into the appropriate entry widget
	    set f $tl.quals.canvas.f.fr_$varname
	    $f.entry delete 0 end
	    $f.entry insert end $value

	    ;##- Set the state of the checkbutton
	    set tlbase [string range $tl 1 end]
	    set ::checkbutton$tlbase\($varname) 1

	    ;##- Change the foreground colors for the entry and option menu
	    $f.menu config -foreground black
	    $f.entry config -foreground black
	}
    }

    ;##- Build the SQL query according to the initial settings
    BuildQuery $tl $table

    return
}


##=========================================================================
## Name: SetupQualifiers
##
## Description:
##   Table-specific code to specify the available "qualifiers" which can
##   be used to limit a query based on values in a given table.
## 
## Parameters:
##   f -- Tk pathname of the parent frame in which to create qualifier areas
##   table -- database table name, used to determine what qualifiers are set up
##
## Usage:
##   SetupQualifiers f table
##
## Comments:
##   Called by BuildQueryDialog;
##   calls the routines SetOrderBy, SetMaxFetch, CompareText, CompareNumeric,
##   CompareText, and DistinctOption to actually create each qualifier.

proc SetupQualifiers { f table } {

    SetMaxFetch $f 100

    set tlbase [string range [winfo toplevel $f] 1 end]
    set ::epochQual$tlbase ""

    switch -- [string tolower $table] {

	process {
	    SetOrderBy $f start_time
	    CompareText $f program -text "program name" -listtable $table
	    CompareText $f version -text "version string"
	    CompareText $f username text "username"
	    CompareText $f node -text "node" -listtable $table
	    CompareNumeric $f unix_procid -text "unix process ID"
	    CompareJobnum $f -text "LDAS job ID" -listtable $table
	    CompareUsertag $f -text "LDAS job user tag" -listtable $table
	    CompareNumeric $f creator_db -text "creator database ID"
	    CompareText $f process_id -text "process unique ID"
	    CompareNumeric $f is_online -text "online flag"
	    CompareText $f ifos -text "interferometer(s)" -listtable $table
	    CompareNumeric $f start_time -text "start time" -time gps
	    CompareNumeric $f end_time -text "end time" -time gps
	    CompareNumeric $f param_set -text "parameter set"
	    DistinctOption $f
	}

	process_params {
	    SetOrderBy $f "process_id, param"
	    CompareText $f program -text "program name" -listtable $table
	    CompareJobnum $f -text "LDAS job ID" -listtable $table
	    CompareUsertag $f -text "LDAS job user tag" -listtable $table
	    CompareNumeric $f creator_db -text "creator database ID"
	    CompareText $f process_id -text "process unique ID"
	    CompareText $f param -text "parameter name" -listtable $table
	    CompareText $f value -text "value"
	    DistinctOption $f
	}

	search_summary {
	    SetOrderBy $f "in_start_time, in_start_time_ns"
	    CompareText $f shared_object -text "shared-object name" \
		    -listtable $table
	    CompareJobnum $f -text "LDAS job ID" -listtable $table
	    CompareUsertag $f -text "LDAS job user tag" -listtable $table
	    CompareNumeric $f in_start_time -text "input start time"
	    CompareNumeric $f in_end_time -text "input end time"
	    CompareNumeric $f out_start_time -text "output start time"
	    CompareNumeric $f out_end_time -text "output end time"
	    CompareNumeric $f nevents -text "number of events found"
	    CompareNumeric $f creator_db -text "creator database ID"
	    CompareText $f process_id -text "process unique ID"
	    CompareText $f comment -text "comment"
	    DistinctOption $f
	}

	search_summvars {
	    SetOrderBy $f "name"
	    CompareJobnum $f -text "LDAS job ID" -listtable $table
	    CompareUsertag $f -text "LDAS job user tag" -listtable $table
	    CompareText $f name -text "variable name" -listtable $table
	    CompareText $f string -text "string value"
	    CompareNumeric $f value -text "numeric value"
	    CompareNumeric $f creator_db -text "creator database ID"
	    CompareText $f process_id -text "process unique ID"
	    DistinctOption $f
	}

	filter {
	    SetOrderBy $f "process_id, filter_name"
	    CompareText $f program -text "program name" -listtable $table
	    CompareJobnum $f -text "LDAS job ID" -listtable $table
	    CompareUsertag $f -text "LDAS job user tag" -listtable $table
	    CompareNumeric $f creator_db -text "creator database ID"
	    CompareText $f process_id -text "process unique ID"
	    CompareText $f filter_name -text "filter name"
	    CompareText $f filter_id -text "filter ID"
	    CompareNumeric $f param_set -text "parameter set"
	    DistinctOption $f
	}

	filter_params {
	    SetOrderBy $f "filter_id, filter_name, param"
	    CompareText $f filter_name -text "filter name" -listtable $table
	    CompareJobnum $f -text "LDAS job ID" -listtable $table
	    CompareUsertag $f -text "LDAS job user tag" -listtable $table
	    CompareNumeric $f creator_db -text "creator database ID"
	    CompareText $f filter_id -text "unique filter ID"
	    CompareText $f param -text "parameter name" -listtable $table
	    CompareText $f value -text "value"
	    DistinctOption $f
	}

	frameset_chanlist {
	    SetOrderBy $f "start_time, frameset_group"
	    CompareNumeric $f creator_db -text "creator database ID"
	    CompareText $f process_id -text "process unique ID"
	    CompareText $f frameset_group -text "frameset group" \
		    -listtable $table
	    CompareText $f chanlist_id -text "channel list ID"
	    CompareNumeric $f start_time -text "start time" -time gps
	    CompareNumeric $f end_time -text "end time" -time gps
	    CompareText $f chanlist -text "channel list"
	    DistinctOption $f
	}

	frameset_writer {
	    SetOrderBy $f "frameset_group"
	    CompareText $f program -text "program name" -listtable $table
	    CompareNumeric $f creator_db -text "creator database ID"
	    CompareText $f process_id -text "process unique ID"
	    CompareText $f frameset_group -text "frameset group" \
		    -listtable $table
	    CompareText $f data_source -text "data source"
	    CompareText $f ifos -text "interferometer(s)" -listtable $table
	    CompareText $f comment -text "comment"
	    DistinctOption $f
	}

	frameset {
	    SetOrderBy $f "start_time"
	    EpochColumn [winfo toplevel $f] start_time
	    CompareText $f name -text "frameset name"

	    ;##- Note list is based on a different table for query speed
	    CompareText $f frameset_group -text "frameset group" \
		    -listtable frameset_writer

	    CompareNumeric $f start_time -text "start time" -time gps
	    CompareNumeric $f end_time -text "end time" -time gps \
		    -after start_time
	    CompareNumeric $f n_frames -text "number of frames"
	    CompareNumeric $f missing_frames -text "number of missing frames"
	    CompareNumeric $f creator_db -text "creator database ID"
	    CompareText $f process_id -text "process unique ID"
	    CompareNumeric $f chanlist_cdb \
		    -text "creator database ID for channel list"
	    CompareText $f chanlist_id -text "channel list ID"
	    DistinctOption $f
	}

	frameset_loc {
	    SetOrderBy $f "name"
	    CompareText $f name -text "frameset name"
	    CompareText $f media_type -text "media type" -listtable $table
	    CompareText $f node -text "node or media label" -listtable $table
	    CompareText $f media_status -text "media status" -listtable $table
	    CompareText $f fullname -text "full file name (with path)"
	    DistinctOption $f
	}

	segment_definer {
	    SetOrderBy $f "segment_group"
	    CompareText $f program -text "program name" -listtable $table
	    CompareNumeric $f creator_db -text "creator database ID"
	    CompareText $f process_id -text "process unique ID"
	    CompareText $f segment_group -text "segment group" \
		    -listtable $table
	    CompareNumeric $f version -text "segment group version"
	    CompareText $f ifos -text "interferometer(s)" -listtable $table
	    CompareText $f comment -text "comment"
	    DistinctOption $f
	}

	segment {
	    SetOrderBy $f "start_time, start_time_ns"
	    EpochColumn [winfo toplevel $f] start_time
	    CompareText $f segment_group -text "segment group" \
		    -listtable $table
	    CompareNumeric $f version -text "segment group version"
	    CompareNumeric $f start_time -text "start time" -time gps
	    CompareNumeric $f end_time -text "end time" -time gps \
		    -after start_time
	    CompareNumeric $f creator_db -text "creator database ID"
	    CompareText $f process_id -text "process unique ID"
	    DistinctOption $f
	}

	summ_value {
	    SetOrderBy $f "start_time, start_time_ns, name"
	    EpochColumn [winfo toplevel $f] start_time
	    CompareText $f program -text "program name" -listtable $table
	    CompareJobnum $f -text "LDAS job ID" -listtable $table
	    CompareUsertag $f -text "LDAS job user tag" -listtable $table
	    CompareNumeric $f creator_db -text "creator database ID"
	    CompareText $f process_id -text "process unique ID"
	    CompareText $f ifo -text "interferometer" -listtable $table
	    CompareText $f name -text "description of value" -listtable $table
	    CompareNumeric $f start_time -text "start time" -time gps
	    CompareNumeric $f end_time -text "end time" -time gps \
		    -after start_time
	    CompareNumeric $f value -text "value"
	    CompareText $f frameset_group -text "frameset group" \
		    -listtable $table
	    CompareText $f segment_group -text "segment group" \
		    -listtable $table
	    CompareNumeric $f version -text "segment group version"
	    DistinctOption $f
	}

	summ_statistics {
	    SetOrderBy $f "start_time, start_time_ns, channel"
	    EpochColumn [winfo toplevel $f] start_time
	    CompareText $f program -text "program name" -listtable $table
	    CompareJobnum $f -text "LDAS job ID" -listtable $table
	    CompareUsertag $f -text "LDAS job user tag" -listtable $table
	    CompareNumeric $f creator_db -text "creator database ID"
	    CompareText $f process_id -text "process unique ID"
	    CompareText $f channel -text "channel name" -listtable $table
	    CompareNumeric $f start_time -text "start time" -time gps
	    CompareNumeric $f end_time -text "end time" -time gps \
		    -after start_time
	    CompareNumeric $f frames_used \
		    -text "number of frames used to calculate statistics"
	    CompareNumeric $f min_value \
		    -text "minimum value during time period"
	    CompareNumeric $f max_value \
		    -text "maximum value during time period"
	    CompareNumeric $f mean -text "mean value"
	    CompareNumeric $f rms -text "rms"
	    CompareText $f frameset_group -text "frameset group" \
		    -listtable $table
	    CompareText $f segment_group -text "segment group" \
		    -listtable $table
	    CompareNumeric $f version -text "segment group version"
	    DistinctOption $f
	}

	summ_spectrum {
	    SetSelectedColumns $f "creator_db, program, process_id,\
		    frameset_group, segment_group, version, start_time,\
		    start_time_ns, end_time, end_time_ns, frames_used,\
		    start_frequency, delta_frequency, mimetype, channel,\
		    spectrum_type, spectrum_length"
	    SetOrderBy $f "start_time, start_time_ns, spectrum_type"
	    EpochColumn [winfo toplevel $f] start_time
	    CompareText $f program -text "program name" -listtable $table
	    CompareJobnum $f -text "LDAS job ID" -listtable $table
	    CompareUsertag $f -text "LDAS job user tag" -listtable $table
	    CompareNumeric $f creator_db -text "creator database ID"
	    CompareText $f process_id -text "process unique ID"
	    CompareText $f channel -text "channel name" -listtable $table
	    CompareText $f spectrum_type -text "spectrum type" \
		    -listtable $table
	    CompareNumeric $f start_time -text "start time" -time gps
	    CompareNumeric $f end_time -text "end time" -time gps \
		    -after start_time
	    CompareNumeric $f frames_used \
		    -text "number of frames used to calculate statistics"
	    CompareText $f frameset_group -text "frameset group" \
		    -listtable $table
	    CompareText $f segment_group -text "segment group" \
		    -listtable $table
	    CompareNumeric $f version -text "segment group version"
	    DistinctOption $f
	}

	summ_csd {
	    SetSelectedColumns $f "creator_db, program, process_id,\
		    frameset_group, segment_group, version, start_time,\
		    start_time_ns, end_time, end_time_ns, frames_used,\
		    start_frequency, delta_frequency, mimetype, channel1,\
		    channel2, spectrum_type, spectrum_length"
	    SetOrderBy $f "start_time, start_time_ns, spectrum_type"
	    EpochColumn [winfo toplevel $f] start_time
	    CompareText $f program -text "program name" -listtable $table
	    CompareJobnum $f -text "LDAS job ID" -listtable $table
	    CompareUsertag $f -text "LDAS job user tag" -listtable $table
	    CompareNumeric $f creator_db -text "creator database ID"
	    CompareText $f process_id -text "process unique ID"
	    CompareText $f channel1 -text "channel 1 name" -listtable $table
	    CompareText $f channel2 -text "channel 2 name" -listtable $table
	    CompareText $f spectrum_type -text "spectrum type" \
		    -listtable $table
	    CompareNumeric $f start_time -text "start time" -time gps
	    CompareNumeric $f end_time -text "end time" -time gps \
		    -after start_time
	    CompareNumeric $f frames_used \
		    -text "number of frames used to calculate statistics"
	    CompareText $f frameset_group -text "frameset group" \
		    -listtable $table
	    CompareText $f segment_group -text "segment group" \
		    -listtable $table
	    CompareNumeric $f version -text "segment group version"
	    DistinctOption $f
	}

	summ_mime {
	    SetSelectedColumns $f "creator_db, process_id, origin, filename,\
		    submitter, submit_time, frameset_group, segment_group,\
		    version, start_time, start_time_ns, end_time, end_time_ns,\
		    channel, descrip, mimedata_length, mimetype, comment,\
		    summ_mime_id"
	    SetOrderBy $f "start_time, start_time_ns"
	    EpochColumn [winfo toplevel $f] start_time
	    CompareText $f origin -text "origin" -listtable $table
	    CompareNumeric $f creator_db -text "creator database ID"
	    CompareText $f process_id -text "process unique ID"
	    CompareText $f submitter -text "person submitting item" \
		    -listtable $table
	    CompareNumeric $f start_time -text "start time" -time gps
	    CompareNumeric $f end_time -text "end time" -time gps \
		    -after start_time
	    CompareText $f channel -text "channel"
	    CompareText $f descrip -text "description of item"
	    CompareText $f mimetype -text "MIME type" -listtable $table
	    CompareText $f frameset_group -text "frameset group" \
		    -listtable $table
	    CompareText $f segment_group -text "segment group" \
		    -listtable $table
	    CompareNumeric $f version -text "segment group version"
	    DistinctOption $f
	}

	summ_comment {
	    SetOrderBy $f "start_time"
	    EpochColumn [winfo toplevel $f] start_time
	    CompareText $f program -text "program name" -listtable $table
	    CompareNumeric $f creator_db -text "creator database ID"
	    CompareText $f process_id -text "process unique ID"
	    CompareText $f submitter -text "person submitting comment" \
		    -listtable $table
	    CompareText $f ifo \
		    -text "interferometer/site to which comment applies" \
		    -listtable $table
	    CompareNumeric $f start_time -text "start time" -time gps
	    CompareNumeric $f end_time -text "end time" -time gps \
		    -after start_time
	    CompareText $f text -text "comment text"
	    CompareText $f frameset_group -text "frameset group" \
		    -listtable $table
	    CompareText $f segment_group -text "segment group" \
		    -listtable $table
	    CompareNumeric $f version -text "segment group version"
	    DistinctOption $f
	}

	gds_trigger {
	    SetOrderBy $f "start_time, start_time_ns, name, subtype"
	    EpochColumn [winfo toplevel $f] start_time
	    CompareText $f name -text "trigger name" -listtable $table
	    CompareText $f subtype -text "trigger subtype" -listtable $table
	    CompareText $f ifo -text "site/interferometer" -listtable $table
	    CompareNumeric $f start_time -text "trigger start time" -time gps
	    CompareNumeric $f duration -text "trigger duration (seconds)"
	    CompareNumeric $f priority -text "trigger priority" \
		    -listtable $table
	    CompareNumeric $f disposition -text "trigger disposition" \
		    -listtable $table
	    CompareNumeric $f size -text "size"
	    CompareNumeric $f significance -text "significance"
	    CompareNumeric $f frequency -text "frequency"
        CompareNumeric $f bandwidth -text "bandwidth"
	    CompareNumeric $f time_peak -text "time_peak"
	    CompareNumeric $f time_average -text "time_average"
	    CompareNumeric $f time_sigma -text "time_sigma"
	    CompareNumeric $f freq_peak -text "freq_peak"
	    CompareNumeric $f freq_average -text "freq_average"
	    CompareNumeric $f freq_sigma -text "freq_sigma"
	    CompareNumeric $f noise_power -text "noise power"
	    CompareNumeric $f signal_power -text "signal power"
	    CompareNumeric $f pixel_count -text "pixel count"
	    CompareNumeric $f confidence -text "confidence"
	    CompareNumeric $f binarydata_length \
		    -text "length of binary data (bytes)"
	    CompareNumeric $f creator_db -text "creator database ID"
	    CompareText $f process_id -text "process unique ID"
	    CompareText $f filter_id -text "filter ID"
	    CompareText $f event_id -text "event ID"
	    DistinctOption $f
	}

	sngl_inspiral {
	    SetOrderBy $f "end_time, end_time_ns"
	    EpochColumn [winfo toplevel $f] end_time
	    CompareText $f search \
		    -text "search algorithm name" -listtable $table
	    CompareText $f channel -text "channel" \
		    -default [list "is null or" "LSC-AS_Q"] \
		    -listtable $table
	    CompareJobnum $f -text "LDAS job ID" -listtable $table
	    CompareUsertag $f -text "LDAS job user tag" -listtable $table
	    CompareText $f ifo -text "interferometer" -listtable $table
	    CompareNumeric $f end_time -text "coalescence time" -time gps
	    ## CompareNumeric $f impulse_time -text "impulse time" -time gps
	    CompareNumeric $f amplitude \
		    -text "signal amplitude (fractional strain)"
	    CompareNumeric $f eff_distance -text "effective distance (Mpc)"
	    CompareNumeric $f mass1 \
		    -text "mass of heavier object (solar masses)"
	    CompareNumeric $f mass2 \
		    -text "mass of lighter object (solar masses)"
	    CompareNumeric $f mchirp -text "chirp mass"
	    CompareNumeric $f snr -text "signal-to-noise ratio"
	    CompareNumeric $f chisq -text "chi-squared"
	    CompareNumeric $f sigmasq -text "sigma-squared"
	    CompareNumeric $f creator_db -text "creator database ID"
	    CompareText $f process_id -text "process unique ID"
	    CompareText $f filter_id -text "filter ID"
	    CompareText $f event_id -text "event ID"
	    DistinctOption $f
	}

	sngl_burst {
	    SetOrderBy $f "start_time, start_time_ns"
	    EpochColumn [winfo toplevel $f] start_time
	    CompareText $f search \
		    -text "search algorithm name" -listtable $table
	    CompareJobnum $f -text "LDAS job ID" -listtable $table
	    CompareUsertag $f -text "LDAS job user tag" -listtable $table
	    CompareText $f ifo -text "interferometer" -listtable $table
	    CompareNumeric $f start_time -text "event start time" -time gps
	    CompareNumeric $f duration -text "event duration (seconds)"
	    CompareNumeric $f central_freq -text "central frequency (Hz)"
	    CompareNumeric $f bandwidth -text "bandwidth (Hz)"
	    CompareNumeric $f amplitude \
		    -text "signal amplitude (fractional strain)"
	    CompareNumeric $f snr -text "signal-to-noise ratio"
	    CompareNumeric $f confidence -text "confidence"
	    CompareNumeric $f creator_db -text "creator database ID"
	    CompareText $f process_id -text "process unique ID"
	    CompareText $f filter_id -text "filter ID"
	    CompareText $f event_id -text "event ID"
	    DistinctOption $f
	}

	waveburst {
	    SetOrderBy $f "start_time, start_time_ns"
	    EpochColumn [winfo toplevel $f] start_time
	    CompareJobnum $f -text "LDAS job ID" -listtable $table
	    CompareUsertag $f -text "LDAS job user tag" -listtable $table
	    CompareText $f ifo_1 -text "interferometer 1" -listtable $table
	    CompareText $f ifo_2 -text "interferometer 2" -listtable $table
	    CompareText $f channel_1 -text "channel 1" -listtable $table
	    CompareText $f channel_2 -text "channel 2" -listtable $table
	    CompareNumeric $f start_time -text "event start time" -time gps
	    CompareNumeric $f stop_time -text "event stop time" -time gps
	    CompareNumeric $f duration -text "event duration (seconds)"
	    CompareNumeric $f cluster_id -text "cluster id"
	    CompareNumeric $f cluster_type -text "cluster type" \
		    -listtable $table
	    CompareNumeric $f volume -text "cluster volume (pixels)"
	    CompareNumeric $f core_size -text "core size"
	    CompareNumeric $f xcorrelation -text "xcorrelation"
	    CompareNumeric $f rcorrelation -text "rcorrelation"
	    CompareNumeric $f likelihood -text "likelihood"
	    CompareNumeric $f power -text "power"
	    CompareNumeric $f max_amplitude -text "maximum amplitude"
	    CompareNumeric $f start_frequency -text "start frequency"
	    CompareNumeric $f stop_frequency -text "stop frequency"
	    CompareNumeric $f bandwidth -text "bandwidth"
	    CompareNumeric $f rel_start_time -text "relative start time"
	    CompareNumeric $f rel_stop_time -text "relative stop time"
	    CompareNumeric $f sim_type -text "simulation type" \
		    -listtable $table
	    CompareText $f simulation_id -text "simulation ID" \
		    -listtable $table
	    CompareText $f process_id -text "process unique ID"
	    CompareText $f filter_id -text "filter ID"
	    CompareText $f event_id -text "event ID"
	    CompareText $f comment -text "comment"
	    DistinctOption $f
	}

	sngl_block {
	    SetOrderBy $f "start_time, start_time_ns"
	    EpochColumn [winfo toplevel $f] start_time
	    CompareText $f search \
		    -text "search algorithm name" -listtable $table
	    CompareJobnum $f -text "LDAS job ID" -listtable $table
	    CompareUsertag $f -text "LDAS job user tag" -listtable $table
	    CompareText $f ifo -text "interferometer" -listtable $table
	    CompareText $f channel -text "channel" -listtable $table
	    CompareNumeric $f start_time -text "event start time" -time gps
	    CompareNumeric $f end_time -text "event end time" -time gps
	    CompareNumeric $f band_index -text "band index"
	    CompareNumeric $f creator_db -text "creator database ID"
	    CompareText $f process_id -text "process unique ID"
	    CompareText $f filter_id -text "filter ID"
	    CompareText $f event_id -text "event ID"
	    DistinctOption $f
	}

	sngl_ringdown {
	    SetOrderBy $f "start_time, start_time_ns"
	    EpochColumn [winfo toplevel $f] start_time
	    CompareJobnum $f -text "LDAS job ID" -listtable $table
	    CompareUsertag $f -text "LDAS job user tag" -listtable $table
	    CompareText $f ifo -text "interferometer" -listtable $table
	    CompareNumeric $f start_time -text "event start time" -time gps
	    CompareNumeric $f duration -text "event duration (seconds)"
	    CompareNumeric $f amplitude \
		    -text "signal amplitude (fractional strain)"
	    CompareNumeric $f frequency \
		    -text "fundamental ringdown frequency (Hz)"
	    CompareNumeric $f q -text "quality factor"
	    CompareNumeric $f mass -text "black hole mass (solar masses)"
	    CompareNumeric $f snr -text "signal-to-noise ratio"
	    CompareNumeric $f confidence -text "confidence"
	    CompareNumeric $f creator_db -text "creator database ID"
	    CompareText $f process_id -text "process unique ID"
	    CompareText $f filter_id -text "filter ID"
	    CompareText $f event_id -text "event ID"
	    DistinctOption $f
	}

	sngl_unmodeled {
	    SetOrderBy $f "start_time, start_time_ns, search"
	    EpochColumn [winfo toplevel $f] start_time
	    CompareJobnum $f -text "LDAS job ID" -listtable $table
	    CompareUsertag $f -text "LDAS job user tag" -listtable $table
	    CompareText $f search \
		    -text "search algorithm name" -listtable $table
	    CompareText $f ifo -text "interferometer" -listtable $table
	    CompareNumeric $f start_time -text "event start time" -time gps
	    CompareNumeric $f duration -text "event duration (seconds)"
	    CompareNumeric $f amplitude \
		    -text "signal amplitude (fractional strain)"
	    CompareNumeric $f snr -text "signal-to-noise ratio"
	    CompareNumeric $f confidence -text "confidence"
	    CompareNumeric $f creator_db -text "creator database ID"
	    CompareText $f process_id -text "process unique ID"
	    CompareText $f filter_id -text "filter ID"
	    CompareText $f event_id -text "event ID"
	    DistinctOption $f
	}

	sngl_unmodeled_v {
	    SetOrderBy $f "event_id, name"
	    CompareNumeric $f creator_db -text "creator database ID"
	    CompareText $f event_id -text "event ID"
	    CompareText $f ifo -text "interferometer" -listtable $table
	    CompareText $f name -text "parameter name" -listtable $table
	    CompareNumeric $f value -text "parameter value"
	    DistinctOption $f
	}

	sngl_dperiodic {
	    SetOrderBy $f "start_time, start_time_ns, target_name, end_time"
	    EpochColumn [winfo toplevel $f] start_time
	    CompareJobnum $f -text "LDAS job ID" -listtable $table
	    CompareUsertag $f -text "LDAS job user tag" -listtable $table
	    CompareText $f ifo -text "interferometer" -listtable $table
	    CompareText $f target_name -text "target name" -listtable $table
	    CompareNumeric $f sky_ra -text "right ascension (degrees)"
	    CompareNumeric $f sky_dec -text "declination (degrees)"
	    CompareNumeric $f start_time -text "start time" -time gps
	    CompareNumeric $f end_time -text "end time" -time gps \
		    -after start_time
	    CompareNumeric $f duration -text "duration (seconds)"
	    CompareNumeric $f frequency -text "frequency (Hz)"
	    CompareNumeric $f amplitude \
		    -text "signal amplitude (fractional strain)"
	    CompareNumeric $f snr -text "signal-to-noise ratio"
	    CompareNumeric $f confidence -text "confidence"
	    CompareNumeric $f creator_db -text "creator database ID"
	    CompareText $f process_id -text "process unique ID"
	    CompareText $f filter_id -text "filter ID"
	    CompareText $f event_id -text "event ID"
	    DistinctOption $f
	}

	sngl_datasource {
	    SetOrderBy $f "event_id"
	    CompareText $f event_table -text "event table" -listtable $table
	    CompareNumeric $f creator_db -text "creator database ID"
	    CompareText $f event_id -text "event ID"
	    CompareText $f ifo -text "site/interferometer" -listtable $table
	    CompareText $f data_source -text "data source(s)" -listtable $table
	    CompareText $f channels -text "channel(s)" -listtable $table
	    CompareNumeric $f start_time -text "data start time" -time gps
	    CompareNumeric $f end_time -text "data end time" -time gps \
		    -after start_time
	}

	sngl_transdata {
	    SetSelectedColumns $f "creator_db, process_id, event_table,\
		    event_id, ifo, transdata_name, dimensions, x_bins,\
		    x_start, x_end, x_units, y_bins, y_start, y_end, y_units,\
		    data_type, data_units, transdata_length"
	    SetOrderBy $f "event_id"
	    CompareText $f event_table -text "event table" -listtable $table
	    CompareNumeric $f creator_db -text "creator database ID"
	    CompareText $f event_id -text "event ID"
	    CompareText $f ifo -text "site/interferometer" -listtable $table
	    CompareText $f transdata_name \
		    -text "description of transformed data" \
		    -listtable $table
	}

	sngl_mime {
	    SetSelectedColumns $f "creator_db, process_id, event_table,\
		    event_id, ifo, origin, filename, submitter, submit_time,\
		    mimedata_length, mimetype, descrip, comment, sngl_mime_id"
	    SetOrderBy $f "event_id"
	    CompareText $f origin -text "origin" -listtable $table
	    CompareNumeric $f creator_db -text "creator database ID"
	    CompareText $f process_id -text "process unique ID"
	    CompareText $f event_table -text "event table" -listtable $table
	    CompareNumeric $f start_time -text "start time" -time gps
	    CompareNumeric $f end_time -text "end time" -time gps \
		    -after start_time
	    CompareText $f descrip -text "description of item"
	    CompareText $f mimetype -text "MIME type" -listtable $table
	    DistinctOption $f
	}

	coinc_sngl {
	    SetOrderBy $f "coinc_time, coinc_time_ns"
	    EpochColumn [winfo toplevel $f] coinc_time
	    CompareNumeric $f coinc_time -text "coincidence time" -time gps
	    CompareNumeric $f coinc_quality -text "coincidence quality"
	    CompareText $f grb_id -text "gamma-ray burst identifier"
	    CompareNumeric $f grb_time -text "gamma-ray burst time" -time gps
	    CompareText $f other_external \
		    -text "reference to other external event(s)"
	    CompareNumeric $f inspiral_mass1 -text \
		    "(inspiral) mass of heavier object (solar masses)"
	    CompareNumeric $f inspiral_mass2 -text \
		    "(inspiral) mass of lighter object (solar masses)"
	    CompareNumeric $f ringdown_freq \
		    -text "(ringdown) fundamental frequency (Hz)"
	    CompareNumeric $f ringdown_q -text "(ringdown) quality factor"
	    CompareNumeric $f ringdown_mass \
		    -text "(ringdown) black hole mass (solar masses)"
	    CompareNumeric $f creator_db -text "creator database ID"
	    CompareText $f process_id -text "process unique ID"
	    DistinctOption $f
	}

	multi_inspiral {
	    SetOrderBy $f "end_time, end_time_ns"
	    EpochColumn [winfo toplevel $f] end_time
	    CompareText $f ifos -text "interferometers" -listtable $table
	    CompareNumeric $f end_time -text "coalescence time" -time gps
	    CompareNumeric $f duration -text "event duration (seconds)"
	    CompareNumeric $f fout_peak_time \
		    -text "time of peak filter output" -time gps
	    CompareNumeric $f filter_duration \
		    -text "duration of filter (seconds)"
	    CompareNumeric $f amplitude \
		    -text "signal amplitude (fractional strain)"
	    CompareNumeric $f mass1 \
		    -text "mass of heavier object (solar masses)"
	    CompareNumeric $f mass2 \
		    -text "mass of lighter object (solar masses)"
	    CompareNumeric $f coalescence_phase \
		    -text "coalescence phase angle (radians)"
	    CompareNumeric $f eff_distance -text "effective distance"
	    CompareNumeric $f snr -text "signal-to-noise ratio"
	    CompareNumeric $f confidence -text "confidence"
	    CompareNumeric $f creator_db -text "creator database ID"
	    CompareText $f process_id -text "process unique ID"
	    CompareText $f filter_id -text "filter ID"
	    CompareText $f event_id -text "event ID"
	    DistinctOption $f
	}

	multi_burst {
	    SetOrderBy $f "start_time, start_time_ns"
	    EpochColumn [winfo toplevel $f] start_time
	    CompareText $f ifos -text "interferometers" -listtable $table
	    CompareNumeric $f start_time -text "event start time" -time gps
	    CompareNumeric $f duration -text "event duration (seconds)"
	    CompareNumeric $f central_freq -text "central frequency (Hz)"
	    CompareNumeric $f bandwidth -text "bandwidth (Hz)"
	    CompareNumeric $f amplitude \
		    -text "signal amplitude (fractional strain)"
	    CompareNumeric $f snr -text "signal-to-noise ratio"
	    CompareNumeric $f confidence -text "confidence"
	    CompareNumeric $f creator_db -text "creator database ID"
	    CompareText $f process_id -text "process unique ID"
	    CompareText $f filter_id -text "filter ID"
	    CompareText $f event_id -text "event ID"
	    DistinctOption $f
	}

	external_trigger {
	    SetOrderBy $f "start_time, start_time_ns"
	    EpochColumn [winfo toplevel $f] start_time
	    CompareText $f notice_type -text "notice type" -listtable $table
	    CompareText $f trigger_source -text "trigger source" \
		    -listtable $table
	    CompareText $f distributor -text "distributor" -listtable $table
	    CompareNumeric $f insertion_time -text "insertion time" \
		    -time datetime
	    CompareNumeric $f start_time -text "start time" -time gps
	    CompareNumeric $f duration -text "duration (seconds)"
	    CompareNumeric $f amplitude -text "amplitude"
	    CompareNumeric $f signal_to_noise -text "signal-to-noise ratio"
	    CompareNumeric $f right_ascension -text "right ascension (degrees)"
	    CompareNumeric $f declination -text "declination (degrees)"
	    DistinctOption $f
	}

	exttrig_search {
	    SetOrderBy $f "start_time"
	    CompareText $f exttrig_type -text "external trigger type" \
		    -listtable $table
	    CompareText $f exttrig_id -text "external trigger ID"
	    CompareNumeric $f start_time -text "external trigger start time" \
		    -time gps
	    CompareNumeric $f segment_type -text "segment type"
	    CompareNumeric $f amplitude -text "amplitude"
	    CompareNumeric $f snr -text "signal-to-noise ratio"
	    CompareNumeric $f percent_bad -text "percent bad data"
	    CompareText $f event_id -text "event ID"
	    DistinctOption $f
	}

	calib_info {
	    SetSelectedColumns $f "valid_start, valid_end, origin,\
		    origin_time, insertion_time, submitter, channel, units,\
		    caltype, comment"
	    SetOrderBy $f "channel, valid_start"
	    CompareText $f channel -text "channel" -listtable $table
	    CompareText $f units -text "unit string" -listtable $table
	    CompareNumeric $f caltype -text "calibration type bitmask" \
		    -listtable $table
	    CompareNumeric $f valid_start \
		    -text "valid time interval start (GPS)" -time gps
	    CompareNumeric $f valid_end \
		    -text "valid time interval end (GPS)" -time gps
	    CompareText $f origin -text "origin of this info" -listtable $table
	    CompareNumeric $f origin_time -text "time of origin (GPS)" \
		    -time gps
	    CompareNumeric $f insertion_time -text "insertion time" \
		    -time datetime
	    CompareText $f insert_by -text "inserted by" -listtable $table
	    DistinctOption $f
	}

    }

    return
}

##=========================================================================
## Name: SetMaxFetch
##
## Description:
##   Routine to set the initial contents of the "Maximum number of records
##   to fetch" entry widget in a "build query" dialog.
## 
## Parameters:
##   parent -- Tk pathname of parent frame for the qualifiers
##   number -- Number to insert into entry area
##
## Usage:
##   SetMaxFetch parent number
##
## Comments:
##   Called by SetupQualifiers.
##   Note that the "parent" argument is NOT actually the parent of the
##   max-fetch area, but it's what we have to work with since this routine
##   is called from SetupQualifiers for organizational convenience.

proc SetMaxFetch { parent number } {
###    puts "in SetMaxFetch, parent is $parent"
    ;##- Trim off the last three elements from the Tk pathname,
    ;##- to infer the name of the max-fetch entry widget
    set tl [winfo parent [winfo parent [winfo parent $parent]]]

    $tl.maxfetch.entry delete 0 end
    $tl.maxfetch.entry insert end $number

    return
}

##=========================================================================
## Name: SetOrderBy
##
## Description:
##   Routine to set the initial contents of the "Order by column(s)" entry
##   widget in a "build query" dialog.
## 
## Parameters:
##   parent -- Tk pathname of parent frame for the qualifiers
##   varname -- string containing database variable name(s) to order by
##
## Usage:
##   SetOrderBy parent varname
##
## Comments:
##   Called by SetupQualifiers.
##   Note that the "parent" argument is NOT actually the parent of the
##   order-by area, but it's what we have to work with since this routine
##   is called from SetupQualifiers for organizational convenience.  It's
##   straightforward to strip off the end of it and infer the true pathname
##   for the order-by entry widget.

proc SetOrderBy { parent varname } {
###    puts "in SetOrderBy, parent is $parent"
    ;##- Trim off the last three elements from the Tk pathname,
    ;##- to infer the name of the order-by entry widget
    set tl [winfo parent [winfo parent [winfo parent $parent]]]

    $tl.orderby.entry delete 0 end
    $tl.orderby.entry insert end $varname

    return
}

##=========================================================================
## Name: SetSelectedColumns
##
## Description:
##   Routine to set the initial contents of the "Selected columns" entry
##   widget in a "build query" dialog.
## 
## Parameters:
##   parent -- Tk pathname of parent frame for the qualifiers
##   varname -- string containing database columna name(s) to select
##
## Usage:
##   SetSelectedColumns parent columns
##
## Comments:
##   Called by SetupQualifiers.
##   Note that the "parent" argument is NOT actually the parent of the
##   order-by area, but it's what we have to work with since this routine
##   is called from SetupQualifiers for organizational convenience.  It's
##   straightforward to strip off the end of it and infer the true pathname
##   for the order-by entry widget.

proc SetSelectedColumns { parent columns } {
###    puts "in SetSelectedColumns, parent is $parent"
    ;##- Trim off the last three elements from the Tk pathname,
    ;##- to infer the name of the order-by entry widget
    set tl [winfo parent [winfo parent [winfo parent $parent]]]
    set tlbase [string range $tl 1 end]

    $tl.colsel.entry delete 0 end
    $tl.colsel.entry insert end $columns
    global sqlCmdColumns$tlbase
    set sqlCmdColumns$tlbase "sel"

    return
}

##=========================================================================
## Name: EpochColumn
##
## Description:
##   Sets up the "Data epoch" pull-down menu at the top of the dialog box.
## 
## Parameters:
##   tl -- Tk pathname of toplevel dialog box
##   colname -- database column name to use in comparison
##
## Usage:
##   EpochColumn tl colname
##
## Comments:
##   Called by SetupQualifiers.

proc EpochColumn { tl colname } {

    set tlbase [string range $tl 1 end]

    ;##- Create a label and a pulldown menu
    frame $tl.epoch

    label $tl.epoch.label -text "Data epoch:" -font boldfont

    set menu [eval tk_optionMenu $tl.epoch.menu epoch$tlbase $::epochNames]
    $tl.epoch.menu config -pady 0 -fg blue

    ;##- Set up an appropriate command for each entry in the pulldown menu
    set is3play -1
    for {set index 0} {$index <= [$menu index end]} {incr index} {
	set epoch [lindex $::epochNames $index]
	if { $epoch == "S3 playground" } { set is3play $index }
	if { ! [string is space $::epochQualCore($epoch)] } {
	    regsub -all {COLNAME} $::epochQualCore($epoch) $colname qual
	    set qual " where ($qual)"
	} else {
	    set qual ""
	}
	$menu entryconfigure $index -command \
		"set ::epochQual$tlbase {$qual};\
		$tl.epoch.descrip config -text {$::epochDescrip($epoch)};\
		$tl.queryhead.refresh invoke"
    }

    label $tl.epoch.descrip -text ""

    #hack
    #-- If current database is at one of the sites, set epoch to S3 playground
    if { ( $::dbname == "LHO" || $::dbname == "LLO" ) \
	    && [regexp {_s3$} $::dbinst] && $is3play >= 0 } {
	$menu invoke $is3play
    } else {
	;##- Initially, use the first item in the pulldown menu
	$menu invoke 0
    }

    pack $tl.epoch.label -side left
    pack $tl.epoch.menu -side left
    pack $tl.epoch.descrip -side left
    pack $tl.epoch -side top -fill x -before $tl.qualshead

    return
}


##=========================================================================
## Name: CompareText
##
## Description:
##   Sets up a few widgets which, working together, allow the user to
##   restrict a database query based on a text comparison.
## 
## Parameters:
##   parent -- Tk pathname of parent frame for the qualifiers
##   varname -- database variable name to use in comparison
##   ?options? -- See Usage and Comments
##
## Usage:
##   CompareText parent varname ?-text text? ?-listtable table? ?-list query?
##
## Comments:
##   Called by SetupQualifiers.
##
##   The "-text" option sets the description of the database variable which
##   appears on the screen.  If omitted, the database variable name is used.
##
##   The "-listtable" option causes a button to be created which, when
##   pressed, executes a query to return the distinct values of the given
##   variable in the specified table, which is usually (but not always) the
##   table for which the qualifiers are being set up.  The values appear
##   in a listbox in a new window.
##
##   The "-list" option is an alternative to "-listtable" which lets you
##   explicitly specify the SQL query to generate the list.  This could be
##   necessary for some non-standard query.

proc CompareText { parent varname args } {

    ;##- Determine the toplevel widget name
    set tl [winfo toplevel $parent]

    set tlbase [string range $tl 1 end]
###    puts "parent is $parent, tl is $tl, tlbase is $tlbase"
    global checkbutton$tlbase comptype$tlbase

    ;##- Set defaults
    set labeltext $varname
    set defaultlist {}
    set listquery ""
    set descripopt ""

    ;##- Get options
    foreach { opt optval } $args {
###	puts "Found option $opt with value $optval"
	switch -- $opt {
	    -text { set labeltext $optval }
	    -default { set defaultlist $optval }
	    -listtable {
		set listquery "select distinct $varname\
			FROM ${optval}__EPOCHQUAL__ order by $varname"
	    }
	    -list {
		set listquery $optval
		set descripopt "-description \"List display\""
	    }
	}
    }

    ;##- Force the variable name to lowercase
    set varname [string tolower $varname]

    ;##- Set up a frame for this qualifier
    set f [frame $parent.fr_$varname]

    ;##- Create a checkbutton, a label, and a pull-down menu of
    ;##- comparison types
    checkbutton $f.check -variable "checkbutton$tlbase\($varname)" \
	    -pady 0 -command [selsub {
	if {$checkbutton$tlbase($varname)} {
	    $f.menu config -foreground black
	    $f.entry config -foreground black
	} else {
	    $f.menu config -foreground gray50
	    $f.entry config -foreground gray50
	}
    } f tlbase varname]

    label $f.label -text $labeltext
    set menu [tk_optionMenu $f.menu "comptype$tlbase\($varname)" \
	    "is" "is null or" "is one of" "is not" "is not any of" \
	    "matches" "does not match" \
	    "contains" "contains one of" "contains all of"]
    $f.menu config -pady 0
    $f.menu config -foreground gray50      ;##- Initially grayed out
    pack $f.check $f.label $f.menu -side left

    ;##- If a "list query" was specified, create a button for it
    if { $listquery != "" } {
	button $f.listb -text "List" -pady 0 \
		-command [selsub {
	    regsub {__EPOCHQUAL__} {$listquery} $::epochQual$tlbase tempquery
	    set tempListDisp [Db2Submit $tempquery listbox $descripopt \
		    -lblinks {$f.entry $f.check $f.menu}];
	} f tl tlbase listquery labeltext descripopt ]
	    
	pack $f.listb -side right -padx 4
    }

    ;##- Create an entry widget
    entry $f.entry
    pack $f.entry -side left -fill x -expand true

    ;##- If a default value was given, insert it now
    if { [llength $defaultlist] > 0 } {
	if { [llength $defaultlist] == 1 } {
	    set defcomp "is"
	    set defvalue [lindex $defaultlist 0]
	} else {
	    set defcomp [lindex $defaultlist 0]
	    set defvalue [lindex $defaultlist 1]
	}
	$f.entry insert end $defvalue
	$f.menu.menu invoke $defcomp
	$f.check invoke
    }

    ;##- Set up bindings so that the entry widget can change the checkbutton
    bind $f.entry <Key> [selsub {
	if {[KeyModifiesEntry %K %A]} {
	    set checkbutton$tlbase($varname) 1
	    $f.menu config -foreground black
	    $f.entry config -foreground black
	}
    } f tlbase varname ]

    bind $f.entry <Button-2> [selsub {
	set checkbutton$tlbase($varname) 1
	$f.menu config -foreground black
	$f.entry config -foreground black
    } f tlbase varname ]

    bind $f.entry <KeyRelease-BackSpace> [selsub {
	if {[$f.entry get] == ""} {
	    set checkbutton$tlbase($varname) 0
	    $f.menu config -foreground gray50
	}
    } f tlbase varname ]

    bind $f.entry <KeyRelease-Delete> [selsub {
	if {[$f.entry get] == ""} {
	    set checkbutton$tlbase($varname) 0
	    $f.menu config -foreground gray50
	}
    } f tlbase varname ]

    bind $f.entry <Control-KeyRelease-d> [selsub {
	if {[$f.entry get] == ""} {
	    set checkbutton$tlbase($varname) 0
	    $f.menu config -foreground gray50
	}
    } f tlbase varname ]

    ;##- Now pack the frame for this qualifier
    pack $f -side top -fill x -expand true

    return
}

##=========================================================================
## Name: CompareUsertag
##
## Description:
##   Sets up a few widgets which, working together, allow the user to
##   restrict a database query to entries generated by jobs with a particular
##   value of the "-userTag" specified in the LDAS user command.
## 
## Parameters:
##   parent -- Tk pathname of parent frame for the qualifiers
##   ?options? -- See Usage and Comments
##
## Usage:
##   CompareUsertag parent ?-text text? ?-listtable table? ?-list query?
##
## Comments:
##   Called by SetupQualifiers.
##
##   The "-text" option sets the description of the database variable which
##   appears on the screen.  If omitted, the database variable name is used.
##
##   The "-listtable" option causes a button to be created which, when
##   pressed, executes a query to return the distinct values of the given
##   variable in the specified table, which is usually (but not always) the
##   table for which the qualifiers are being set up.  The values appear
##   in a listbox in a new window.
##
##   The "-list" option is an alternative to "-listtable" which lets you
##   explicitly specify the SQL query to generate the list.  This could be
##   necessary for some non-standard query.

proc CompareUsertag { parent args } {

    ;##- Determine the toplevel widget name
    set tl [winfo toplevel $parent]

    set tlbase [string range $tl 1 end]
###    puts "parent is $parent, tl is $tl, tlbase is $tlbase"
    global checkbutton$tlbase comptype$tlbase

    set varname "zzusertag"

    ;##- Set defaults
    set labeltext "LDAS job user tag"
    set listquery ""
    set descripopt ""

    ;##- Get options
    foreach { opt optval } $args {
###	puts "Found option $opt with value $optval"
	switch -- $opt {
	    -text { set labeltext $optval }
	    -listtable {
		if { [string equal -nocase $optval "process_params"] } {
		    set listquery "select distinct\
			    substr(value,1,64) as USER_TAG from process_params\
			    where param='-userTag'\
			    order by substr(value,1,64)"
		} else {
		    set listquery "select distinct\
			    substr(value,1,64) as USER_TAG from process_params\
			    where param='-userTag' and\
			    (process_id,creator_db) in\
			    (select distinct process_id,creator_db
			    from ${optval})\
			    order by substr(value,1,64)"
		}
	    }
	    -list {
		set listquery $optval
		set descripopt "-description \"List display\""
	    }
	}
    }

    ;##- Force the variable name to lowercase
    set varname [string tolower $varname]

    ;##- Set up a frame for this qualifier
    set f [frame $parent.fr_$varname]

    ;##- Create a checkbutton, a label, and a pull-down menu of
    ;##- comparison types
    checkbutton $f.check -variable "checkbutton$tlbase\($varname)" \
	    -pady 0 -command [selsub {
	if {$checkbutton$tlbase($varname)} {
	    $f.menu config -foreground black
	    $f.entry config -foreground black
	} else {
	    $f.menu config -foreground gray50
	    $f.entry config -foreground gray50
	}
    } f tlbase varname]

    label $f.label -text $labeltext
    set menu [tk_optionMenu $f.menu "comptype$tlbase\($varname)" \
	    "is" "is one of" "is not" "is not any of" \
	    "matches" "does not match" \
	    "contains" "contains one of" "contains all of"]
    $f.menu config -pady 0
    $f.menu config -foreground gray50      ;##- Initially grayed out
    pack $f.check $f.label $f.menu -side left

    ;##- If a "list query" was specified, create a button for it
    if { $listquery != "" } {
	button $f.listb -text "List" -pady 0 \
		-command [selsub {
	    set tempListDisp [Db2Submit {$listquery} listbox $descripopt \
		    -lblinks {$f.entry $f.check $f.menu}];
	} f tl tlbase listquery labeltext descripopt ]
	    
	pack $f.listb -side right -padx 4
    }

    ;##- Create an entry widget
    entry $f.entry
    pack $f.entry -side left -fill x -expand true

    ;##- Set up bindings so that the entry widget can change the checkbutton
    bind $f.entry <Key> [selsub {
	if {[KeyModifiesEntry %K %A]} {
	    set checkbutton$tlbase($varname) 1
	    $f.menu config -foreground black
	    $f.entry config -foreground black
	}
    } f tlbase varname ]

    bind $f.entry <Button-2> [selsub {
	set checkbutton$tlbase($varname) 1
	$f.menu config -foreground black
	$f.entry config -foreground black
    } f tlbase varname ]

    bind $f.entry <KeyRelease-BackSpace> [selsub {
	if {[$f.entry get] == ""} {
	    set checkbutton$tlbase($varname) 0
	    $f.menu config -foreground gray50
	}
    } f tlbase varname ]

    bind $f.entry <KeyRelease-Delete> [selsub {
	if {[$f.entry get] == ""} {
	    set checkbutton$tlbase($varname) 0
	    $f.menu config -foreground gray50
	}
    } f tlbase varname ]

    bind $f.entry <Control-KeyRelease-d> [selsub {
	if {[$f.entry get] == ""} {
	    set checkbutton$tlbase($varname) 0
	    $f.menu config -foreground gray50
	}
    } f tlbase varname ]

    ;##- Now pack the frame for this qualifier
    pack $f -side top -fill x -expand true

    return
}

##=========================================================================
## Name: CompareNumeric
##
## Description:
##   Sets up a few widgets which, working together, allow the user to
##   restrict a database query based on a numeric comparison.
## 
## Parameters:
##   parent -- Tk pathname of parent frame for the qualifiers
##   varname -- database variable name to use in comparison
##   ?options? -- See Usage and Comments
##
## Usage:
##   CompareNumeric parent varname ?-text text?
##
## Comments:
##   Called by SetupQualifiers.
##
##   The "-text" option sets the description of the database variable which
##   appears on the screen.  If omitted, the database variable name is used.

proc CompareNumeric { parent varname args } {

    ;##- Determine the toplevel widget name
    set tl [winfo toplevel $parent]

    set tlbase [string range $tl 1 end]
    global checkbutton$tlbase comptype$tlbase timetype$tlbase aftercol$tlbase
    upvar 0 timetype$tlbase timetype
    upvar 0 aftercol$tlbase aftercol

    ;##- Set defaults
    set labeltext $varname

    ;##- Force the variable name to lowercase
    set varname [string tolower $varname]

    set timetype($varname) none
    set aftercol($varname) ""

    ;##- Get options
    foreach { opt optval } $args {
	switch -- $opt {
	    -text { set labeltext $optval }
	    -time { set timetype($varname) $optval }
	    -after { set aftercol($varname) $optval }
	}
    }

    ;##- Set up a frame for this qualifier
    set f [frame $parent.fr_$varname]

    ;##- Create a checkbutton, a label, and a pull-down menu of comparison types
    checkbutton $f.check -variable "checkbutton$tlbase\($varname)" \
	    -pady 0 -command [selsub {
	if {$checkbutton$tlbase($varname)} {
	    $f.menu config -foreground black
	    $f.entry config -foreground black
	} else {
	    $f.menu config -foreground gray50
	    $f.entry config -foreground gray50
	}
    } f tlbase varname ]

    label $f.label -text $labeltext
    set menu [tk_optionMenu $f.menu "comptype$tlbase\($varname)" \
	    "=" "<" ">" "<>" "<=" ">=" "between"]
    $f.menu config -pady 0
    $f.menu config -foreground gray50      ;##- Initially grayed out
    pack $f.check $f.label $f.menu -side left

    ;##- Set up option-menu bindings to automatically add/remove an AND to/from
    ;##- the entry widget, depending on whether the comparison is "between"
    for {set index 0} {$index <= [$menu index end]} {incr index} {
	$menu entryconfigure $index -command "EntryRemoveAnd $f.entry"
    }
    $menu entryconfigure "between" -command "EntryAddAnd $f.entry"

    ;##- Create an entry widget
    entry $f.entry
    pack $f.entry -side left -fill x -expand true

    ;##- Set up bindings so that the entry widget can change the checkbutton
    bind $f.entry <Key> [selsub {
	if {[KeyModifiesEntry %K %A]} {
	    set checkbutton$tlbase($varname) 1
	    $f.menu config -foreground black
	    $f.entry config -foreground black
	}
    } f tlbase varname ]

    bind $f.entry <Button-2> [selsub {
	set checkbutton$tlbase($varname) 1
	$f.menu config -foreground black
	$f.entry config -foreground black
    } f tlbase varname ]

    bind $f.entry <KeyRelease-BackSpace> [selsub {
	if {[$f.entry get] == ""} {
	    set checkbutton$tlbase($varname) 0
	    $f.menu config -foreground gray50
	}
    } f tlbase varname ]

    bind $f.entry <KeyRelease-Delete> [selsub {
	if {[$f.entry get] == ""} {
	    set checkbutton$tlbase($varname) 0
	    $f.menu config -foreground gray50
	}
    } f tlbase varname ]

    bind $f.entry <Control-KeyRelease-d> [selsub {
	if {[$f.entry get] == ""} {
	    set checkbutton$tlbase($varname) 0
	    $f.menu config -foreground gray50
	}
    } f tlbase varname ]

    ;##- Now pack the frame for this qualifier
    pack $f -side top -fill x

    return
}

##=========================================================================
## Name: CompareJobnum
##
## Description:
##   Sets up a few widgets which, working together, allow the user to
##   restrict a database query to entries generated by a particular LDAS job.
## 
## Parameters:
##   parent -- Tk pathname of parent frame for the qualifiers
##   ?options? -- See Usage and Comments
##
## Usage:
##   CompareJobnum parent ?-text text? ?-listtable table?
##
## Comments:
##   Called by SetupQualifiers.
##
##   The "-text" option sets the description of the database variable which
##   appears on the screen.
##
##   The "-listtable" option causes a button to be created which, when
##   pressed, executes a query to return the distinct values of the given
##   variable in the specified table, which is usually (but not always) the
##   table for which the qualifiers are being set up.  The values appear
##   in a listbox in a new window.

proc CompareJobnum { parent args } {

    ;##- Determine the toplevel widget name
    set tl [winfo toplevel $parent]

    set tlbase [string range $tl 1 end]
    global checkbutton$tlbase comptype$tlbase timetype$tlbase aftercol$tlbase
    upvar 0 timetype$tlbase timetype
    upvar 0 aftercol$tlbase aftercol

    set varname "zzjobnum"

    ;##- Set defaults
    set labeltext "LDAS job ID"
    set listquery ""
    set timetype($varname) none
    set aftercol($varname) ""

    ;##- Get options
    foreach { opt optval } $args {
	switch -- $opt {
	    -text { set labeltext $optval }
	    -listtable {
		if { [string equal -nocase $optval "process"] } {
		    set listquery "select distinct jobid from\
			    ${optval}__EPOCHQUAL__ order by jobid"
		} else {
		    set listquery "select distinct jobid from process\
			    where (process_id,creator_db) in\
			    (select distinct process_id,creator_db\
			    from ${optval}__EPOCHQUAL__) order by jobid"
		}
	    }
	}
    }

    ;##- Set up a frame for this qualifier
    set f [frame $parent.fr_$varname]

    ;##- Create a checkbutton, label, and a pull-down menu of comparison types
    checkbutton $f.check -variable "checkbutton$tlbase\($varname)" \
	    -pady 0 -command [selsub {
	if {$checkbutton$tlbase($varname)} {
	    $f.menu config -foreground black
	    $f.entry config -foreground black
	} else {
	    $f.menu config -foreground gray50
	    $f.entry config -foreground gray50
	}
    } f tlbase varname ]

    label $f.label -text $labeltext
    set menu [tk_optionMenu $f.menu "comptype$tlbase\($varname)" \
	    "is" "is one of" "is not" "is not any of" \
	    "<" ">" "<=" ">=" "between"]
    $f.menu config -pady 0
    $f.menu config -foreground gray50      ;##- Initially grayed out
    pack $f.check $f.label $f.menu -side left

    ;##- Set up option-menu bindings to automatically add/remove an AND to/from
    ;##- the entry widget, depending on whether the comparison is "between"
    for {set index 0} {$index <= [$menu index end]} {incr index} {
	$menu entryconfigure $index -command "EntryRemoveAnd $f.entry"
    }
    $menu entryconfigure "between" -command "EntryAddAnd $f.entry"

    ;##- If a "list query" was specified, create a button for it
    if { $listquery != "" } {
	button $f.listb -text "List" -pady 0 \
		-command [selsub {
	    regsub {__EPOCHQUAL__} {$listquery} $::epochQual$tlbase tempquery
	    set tempListDisp [Db2Submit $tempquery listbox \
		    -description "Values of\n\"$labeltext\"" \
		    -lblinks {$f.entry $f.check $f.menu}];
	} f tl tlbase listquery labeltext ]
	    
	pack $f.listb -side right -padx 4
    }

    ;##- Create an entry widget
    entry $f.entry
    pack $f.entry -side left -fill x -expand true

    ;##- Set up bindings so that the entry widget can change the checkbutton
    bind $f.entry <Key> [selsub {
	if {[KeyModifiesEntry %K %A]} {
	    set checkbutton$tlbase($varname) 1
	    $f.menu config -foreground black
	    $f.entry config -foreground black
	}
    } f tlbase varname ]

    bind $f.entry <Button-2> [selsub {
	set checkbutton$tlbase($varname) 1
	$f.menu config -foreground black
	$f.entry config -foreground black
    } f tlbase varname ]

    bind $f.entry <KeyRelease-BackSpace> [selsub {
	if {[$f.entry get] == ""} {
	    set checkbutton$tlbase($varname) 0
	    $f.menu config -foreground gray50
	}
    } f tlbase varname ]

    bind $f.entry <KeyRelease-Delete> [selsub {
	if {[$f.entry get] == ""} {
	    set checkbutton$tlbase($varname) 0
	    $f.menu config -foreground gray50
	}
    } f tlbase varname ]

    bind $f.entry <Control-KeyRelease-d> [selsub {
	if {[$f.entry get] == ""} {
	    set checkbutton$tlbase($varname) 0
	    $f.menu config -foreground gray50
	}
    } f tlbase varname ]

    ;##- Now pack the frame for this qualifier
    pack $f -side top -fill x -expand true

    return
}

##=========================================================================
## Name: DistinctOption
##
## Description:
##   Sets up a checkbutton in the "qualifiers" area which allows the user
##   to specify that the query results should be filtered to eliminate
##   duplicate rows.
##
## Parameters:
##   parent -- Tk pathname of parent frame for the qualifiers
##
## Usage:
##   DistinctOption parent
##
## Comments:
##   Called by SetupQualifiers.
##   For two rows to be duplicates, they must have the same value in all
##   columns returned by the query.

proc DistinctOption { parent } {

    ;##- Determine the toplevel widget name
    set tl [winfo toplevel $parent]

    set tlbase [string range $tl 1 end]
    global distinct$tlbase

    ;##- Set default
    set distinct$tlbase 0

    ;##- Set up a frame for this qualifier
    set f [frame $parent.distinctopt]

    ;##- Create a labeled checkbutton and a label
    checkbutton $f.check -variable "distinct$tlbase" -pady 0
    label $f.label -text "Eliminate duplicates (based on columns returned)" \
	    -anchor w
    pack $f.check -side left
    pack $f.label -side left -fill x

    ;##- Now pack the frame for this qualifier
    pack $f -side top -fill x

    return
}

##=========================================================================
## Name: BuildQuery
##
## Description:
##   Routine to interrogate all of the widgets in the "build query" dialog
##   and build the SQL query appropriately.
## 
## Parameters:
##   tl -- Tk pathname for toplevel widget of "build query" dialog
##   table -- database table for which query is being built
##
## Usage:
##   BuildQuery tl table
##
## Comments:
##   Puts the resulting query into a the "query" text widget near the bottom
##   of the "build query" dialog.  Does NOT actually submit the query; that
##   is done by clicking the "Refresh & Submit" button.

proc BuildQuery { tl table } {
###    puts "In BuildQuery"

    set tlbase [string range $tl 1 end]
    global sqlCmdColumns$tlbase checkbutton$tlbase comptype$tlbase \
	    distinct$tlbase casecomp$tlbase timetype$tlbase aftercol$tlbase
    upvar 0 checkbutton$tlbase checkbutton
    upvar 0 comptype$tlbase comptype
    upvar 0 casecomp$tlbase casecomp
    upvar 0 timetype$tlbase timetype
    upvar 0 aftercol$tlbase aftercol

    set colsel [set sqlCmdColumns$tlbase]

    switch -- $colsel {

	"all" {
	    set colspec "*"
	}

	"sel" {
	    set colspec [$tl.colsel.entry get]

	    ;##- If user didn't select any columns, set this to something which
	    ;##- will end up giving a somewhat more informative error message
	    if {[string is space $colspec]} {
		set colspec "(no_columns_selected)"
	    }

	    ;##- This needs to be made into a comma-separated list, but the
	    ;##- user may have separated the items by spaces instead.
	    ;##- Do a regsub so that all separations, by spaces and/or commas,
	    ;##- are converted to commas.
	    regsub -all {[,\s]+} $colspec ", " colspec
	}

	"count" {
	    set colspec "COUNT(*)"
	}

	"group" {
	    set colspec "[$tl.colsel.group.by get]"
	    ;##- Make sure this is a comma-separated list.
	    regsub -all {[,\s]+} $colspec ", " colspec

	    ;##- Append the derived column which will contain the count
	    if { ! [string is space $colspec] } {
		append colspec ", COUNT(*) as COUNT"
	    } else {
		set colspec "COUNT(*) as TOTAL"
	    }
	}

    }

    set quals ""

    ;##- Check for an epoch restriction
    set quals [string trim [set ::epochQual$tlbase]]
    
    ;##- Interrogate each of the qualifier widgets
    set distinctopt 0
    set children [winfo children $tl.quals.canvas.f]
    foreach child $children {
	if { [string match $tl.quals.canvas.f.fr_* $child] } {
	    set charpos [string first ".f.fr_" $child]
	    set varname [string tolower \
		    [string range $child [expr {$charpos+6}] end] ]
	    set vartext [$child.label cget -text]
	    set value [string map {"\t" ""} [$child.entry get]]
	    if { $checkbutton($varname) } {

		set comp $comptype($varname)

		;##- For a job-number comparison, if a list of values is given,
		;##- automatically switch to "is one of" or "is not any of"
		if { $varname == "zzjobnum" && [regexp {[ ,]} $value] } {
		    switch $comp {
			"is" { set comp "is one of" }
			"is not" { set comp "is not any of" }
		    }
		}

		switch -glob $comp {

		    "is" -
		    "is not" {

			;##- Pick the comparison operator
			if { $comp == "is" } {
			    set oper "="
			} elseif { $comp == "is not" } {
			    set oper "<>"
			}

			;##- Modify things for case-insensitive matching,
			;##- unless the value is a hexadecimal constant
			if { $casecomp == "are not" \
				&& ! [regexp {^x'[0-9a-fA-F]+'} $value] } {
			    set varname "UPPER($varname)"
			    set value [string toupper $value]
			}

			;##- Check whether this is a hexadecimal constant
			if {[regexp -nocase {^x'.*'$} $value]} {
			    ;##- Hexadecimal constant
			    set qual "($varname $oper $value)"
			} elseif { $varname == "zzjobnum" } {
			    ;##- Strip out just the numerical part
			    if { [regexp {(\d+)\D*$} $value - qualpart] } {
				set qual "($varname $oper $qualpart)"
			    } else {
				set qual "($varname $oper 0_blank)"
			    }	
			} else {
			    ;##- Ordinary string
			    ;##- Escape any embedded apostrophe/single-quote
			    set value [string map { ' '' } $value]
			    set qual "($varname $oper '$value')"
			}
		    }

		    "is null or" {

			;##- Modify things for case-insensitive matching,
			;##- unless the value is a hexadecimal constant
			if { $casecomp == "are not" \
				&& ! [regexp {^x'[0-9a-fA-F]+'} $value] } {
			    set upvarname "UPPER($varname)"
			    set value [string toupper $value]
			} else {
			    set upvarname $varname
			}

			;##- Check whether this is a hexadecimal constant
			if {[regexp -nocase {^x'.*'$} $value]} {
			    ;##- Hexadecimal constant
			    set qual "($varname IS NULL\
				    OR $upvarname = $value)"
			} else {
			    ;##- Ordinary string
			    ;##- Escape any embedded apostrophe/single-quote
			    set value [string map { ' '' } $value]
			    set qual "($varname IS NULL\
				    OR $upvarname = '$value')"
			}

		    }

		    "is one of" -
		    "is not any of" {

			;##- Pick the comparison operator
			if { $comp == "is one of" } {
			    set oper "IN"
			} elseif { $comp == "is not any of" } {
			    set oper "NOT IN"
			}

			;##- Modify things for case-insensitive matching,
			;##- unless the value is a hexadecimal constant
			if { $casecomp == "are not" \
				&& ! [regexp {^x'[0-9a-fA-F]+'} $value] } {
			    set varname "UPPER($varname)"
			    set value [string toupper $value]
			}

			;##- Translate all commas to spaces
			set values [string map { , " " } $value]

			;##- Escape backslashes
			;##- (necessary because we will do an eval)
			set values [string map { \\ \\\\ } $values]

			;##- Turn the string into a Tcl list
			eval "set vallist \[list $values\]"

			;##- Now loop over values and construct the qualifier
			set qual ""
			foreach val $vallist {

			    ;##- Check whether this is a hexadecimal constant
			    if {[regexp -nocase {^x'.*'$} $val]} {
				;##- Hexadecimal constant
				set qualpart "$val"
			    } elseif { $varname == "zzjobnum" } {
				;##- Strip out just the numerical part
				if { ! [regexp {(\d+)\D*$} $val - qualpart] } {
				    set qualpart "0_blank"
				}	
			    } else {
				;##- Ordinary string
				;##- Escape embedded apostrophes/single-quotes
				set val [string map { ' '' } $val]
				set qualpart "'$val'"
			    }

			    if { $qual == "" } {
				set qual $qualpart
			    } else {
				append qual ", $qualpart"
			    }
			}
			set qual "($varname $oper ($qual))"
		    }

		    "matches" -
		    "does not match" {

			;##- Pick the comparison operator
			if { $comp == "matches" } {
			    set oper "LIKE"
			} elseif { $comp == "does not match" } {
			    set oper "NOT LIKE"
			}

			;##- Modify things for case-insensitive matching,
			;##- unless the value is a hexadecimal constant
			if { $casecomp == "are not" \
				&& ! [regexp {^x'[0-9a-fA-F]+'} $value] } {
			    set varname "UPPER($varname)"
			    set value [string toupper $value]
			}

			;##- Trim any trailing wildcards, then append a *
			set value [string trimright $value "*?"]*

			;##- Escape any embedded apostrophe/single-quote
			set value [string map { ' '' } $value]

			;##- Escape all backslashes, underscores, and percents
			regsub -all {[\\_%]} $value {\\&} value

			;##- Translate wildcards from Unix-style to SQL-style
			;##-    Unix "?"   -->   SQL "_"
			;##-    Unix "*"   -->   SQL "%"
			set value [string map {? _ * %} $value]

			;##- Check if any escape characters are present
			if { [string first "\\" $value] > -1 } {
			    set qual "($varname $oper '$value' ESCAPE '\\')"
			} else {
			    set qual "($varname $oper '$value')"
			}
		    }

		    "contains" {

			;##- Modify things for case-insensitive matching,
			;##- unless the value is a hexadecimal constant
			if { $casecomp == "are not" \
				&& ! [regexp {^x'[0-9a-fA-F]+'} $value] } {
			    set varname "UPPER($varname)"
			    set value [string toupper $value]
			}

			;##- Trim any initial or final wildcards
			set value [string trim $value "*?"]

			;##- Escape any embedded apostrophe/single-quote
			set value [string map { ' '' } $value]

			;##- Translate wildcards from Unix-style to SQL-style
			;##-    Unix "?"   -->   SQL "_"
			;##-    Unix "*"   -->   SQL "%"
			set value [string map {? _ * %} $value]

			;##- Check if any escape characters are present
			if { [string first "\\" $value] > -1 } {
			    set qual "($varname LIKE '%$value%' ESCAPE '\\')"
			} else {
			    set qual "($varname LIKE '%$value%')"
			}
		    }

		    "contains ??? of" {

			;##- Pick the comparison operator
			if { $comp == "contains one of" } {
			    set oper "OR"
			} elseif { $comp == "contains all of" } {
			    set oper "AND"
			}

			;##- Modify things for case-insensitive matching,
			;##- unless the value is a hexadecimal constant
			if { $casecomp == "are not" \
				&& ! [regexp {^x'[0-9a-fA-F]+'} $value] } {
			    set varname "UPPER($varname)"
			    set value [string toupper $value]
			}

			;##- Translate all commas to spaces, and escape any
			;##- embedded apostrophe/single-quote
			set values [string map { , { } ' '' } $value]

			;##- Escape all backslashes, underscores, and percents
			regsub -all {[\\_%]} $values {\\&} values

			;##- Do an extra level of escaping on backslashes
			;##- (necessary because we will do an eval)
			set values [string map { \\ \\\\ } $values]

			;##- Turn the string into a Tcl list
			eval "set vallist \[list $values\]"

			;##- Now loop over values and construct the qualifier
			set qual ""
			foreach val $vallist {
			    ;##- Trim any initial or final wildcards
			    set val [string trim $val "*?"]

			    ;##- Translate wildcards from Unix- to SQL-style
			    set val [string map {? _ * %} $val]

			    ;##- Check if any escape characters are present
			    if { [string first "\\" $val] > -1 } {
				set qualpart \
					"$varname LIKE '%$val%' ESCAPE '\\'"
			    } else {
				set qualpart "$varname LIKE '%$val%'"
			    }
			    if { $qual == "" } {
				set qual $qualpart
			    } else {
				append qual " $oper $qualpart"
			    }
			}
			set qual "($qual)"
		    }

		    "=" -
		    "<" -
		    ">" -
		    "<>" -
		    "<=" -
		    ">=" {

			;##- Check if this is a time string
			if { $timetype($varname) == "gps" \
				|| $timetype($varname) == "datetime" } {
			    if {[catch {HandleTimeString $value $tl} value]} {
				;##- HandleTimeString cleared the query text
				;##- area, so no query will be submitted
				return
			    }

			    if { $timetype($varname) == "datetime" } {
				set value [clock format [utcTime $value] \
					-format "%Y-%m-%d %H:%M:%S" -gmt 1]
				set value "TIMESTAMP('$value')"
			    }
			}

			if { $varname == "zzjobnum" } {
			    ;##- Strip out just the numerical part
			    if { ! [regexp {(\d+)\D*$} $value - value] } {
				set value "0_blank"
			    }	
			}

			;##- If value is blank, set it to something which will
			;##- end up giving a somewhat more informative error
			;##- message.
			if { [string is space $value] } { set value "0_blank" }

			;##- If an "-after" option was specified for this
			;##- column, then include a constraint on the specified
			;##- column as well (if comparison is < or <=)
			if { $aftercol($varname) != "" && \
				( $comp == "<" || $comp == "<=" ) } {
			    set qual "($aftercol($varname) $comp $value) AND\
				    ($varname $comp $value)"
			} else {
			    set qual "($varname $comp $value)"
			}
		    }

		    "between" {

			;##- Break up the string into the two values
			if { ! [regexp -nocase {^(.*?)\s+and\s+(.*?)$} \
				$value match val1 val2] \
				|| [string is space $val1] \
				|| [string is space $val2] } {

			    ;##- Clear the query text widget
			    $tl.query.text config -state normal
			    $tl.query.text delete 0.0 end
			    $tl.query.text insert end ""
			    $tl.query.text config -state disabled

			    ;##- Report the error
			    set ignore [ tk_messageBox -parent $tl \
				    -type ok -icon error \
				    -title "Invalid \"between\" specification"\
				    -message \
	"Invalid \"between\" comparison for \"$vartext\". \
	Must give two values separated by AND." ]

			    ;##- Return.  (No query will be submitted.)
			    return
			}

			if { $varname == "zzjobnum" } {
			    ;##- Strip out just the numerical part
			    if { ! [regexp {(\d+)\D*$} $val1 - val1] } {
				set val1 "0_blank"
			    }	
			    if { ! [regexp {(\d+)\D*$} $val2 - val2] } {
				set val2 "0_blank"
			    }	
			}

			;##- If necessary, convert either or both of the 
			;##- values from a time string to GPS seconds

			if { $timetype($varname) == "gps" \
				|| $timetype($varname) == "datetime" } {
			    if { [catch {HandleTimeString $val1 $tl} rval1] } {
				;##- HandleTimeString cleared the query text
				;##- area, so no query will be submitted
				return
			    }

			    if { [catch {HandleTimeString $val2 $tl} rval2] } {
				;##- HandleTimeString cleared the query text
				;##- area, so no query will be submitted
				return
			    }
			} else {
			    set rval1 $val1
			    set rval2 $val2
			}

			;##- Make sure rval2 is >= rval1
			if { $rval2 < $rval1 } {
			    ;##- Clear the query text widget
			    $tl.query.text config -state normal
			    $tl.query.text delete 0.0 end
			    $tl.query.text insert end ""
			    $tl.query.text config -state disabled

			    ;##- Report the error
			    set ignore [ tk_messageBox -parent $tl \
				    -type ok -icon error \
				    -title "Invalid \"between\" range"\
				    -message \
				    "Invalid range for \"$vartext\": \
				    $val2 is less than $val1." ]

			    ;##- Return.  (No query will be submitted.)
			    return
			}

			if { $timetype($varname) == "datetime" } {
			    set rval1 [clock format [utcTime $rval1] \
				    -format "%Y-%m-%d %H:%M:%S" -gmt 1]
			    set rval1 "TIMESTAMP('$rval1')"
			    set rval2 [clock format [utcTime $rval2] \
				    -format "%Y-%m-%d %H:%M:%S" -gmt 1]
			    set rval2 "TIMESTAMP('$rval2')"
			}

			set qual "($varname BETWEEN $rval1 AND $rval2)"
		    }

		}

		;##- If this is the LDAS job number or the user tag, then
		;##- the query is a bit more complex
		if { $varname == "zzjobnum" } {
		    regsub {zzjobnum} $qual "jobid" qual
		    set qual "((process_id,creator_db) in\
			    (select distinct process_id,creator_db\
			    from process where $qual))"
		} elseif { $varname == "zzusertag" } {
		    regsub {zzusertag} $qual "value" qual
		    set qual "((process_id,creator_db) in\
			    (select distinct process_id,creator_db from\
			    process_params where param='-userTag' and $qual))"
		}

		if { $quals == "" } {
		    set quals "WHERE $qual"
		} else {
		    set quals "$quals AND $qual"
		}
	    }

	} elseif { [string equal $tl.quals.canvas.f.distinctopt $child] } {
	    set distinctopt [set distinct$tlbase]
	}
    }

    if { $distinctopt == 0 } {
	set query "SELECT $colspec FROM $table"
    } else {
	set query "SELECT DISTINCT $colspec FROM $table"
    }
    if { $quals != "" } { append query " $quals" }

    ;##- Check the group-by area.
    if { $colsel == "group" } {
	if { [regexp -nocase {^(.*), count\(\*\) as \w*$} \
		$colspec match colsonly] } {
	    append query " GROUP BY $colsonly"
	}
    }

    ;##- Check the order-by area.  If non-blank, add it to the query
    set orderby [string trim [$tl.orderby.entry get]]
    if { $orderby != "" && $colsel != "count" && $colsel != "group" } {

	;##- If the DISTINCT option is being used, then any order-by column
	;##- must also be in the select list.  So, remove any item from
	;##- the order-by list if it is not in the select list.
	if { $colsel == "sel" && $distinctopt } {
	    set collist [regexp -inline -all {[^,\s]+} $colspec]
	    set neworderby ""
	    foreach item [regexp -inline -all {[^,\s]+} $orderby] {
		;##- Note: (?i) switches to case-insensitive search
		if {[lsearch -regexp $collist "(?i)^$item$"] > -1} {
		    append neworderby " $item"
		}
	    }
	    set orderby [string trim $neworderby]
	}

	;##- This needs to be made into a comma-separated list, but the user
	;##- may have separated the items by spaces instead.  Do a regsub
	;##- so that all separations, by spaces and/or commas, are converted
	;##- to commas.
	regsub -all {[,\s]+} $orderby ", " orderby

	if { ! [string is space $orderby] } {

	    ;##- Check whether we should sort in descending order
	    if { [info exists ::orderdir$tlbase] && \
		    [set ::orderdir$tlbase] == "descending" } {
		regsub -all {,} $orderby " DESC," orderby
		append orderby " DESC"
	    }

	    ;##- Add this to the query
	    append query " ORDER BY $orderby"
	}
    }

    ;##- Check the max-fetch area.  If non-blank, add it to the query
    set maxfetch [string trim [$tl.maxfetch.entry get]]
    if {$maxfetch != "" && $colsel != "count"} {
	append query " FETCH FIRST $maxfetch ROWS ONLY"
    }

    ;##- Insert the built query into the query text widget
    $tl.query.text config -state normal
    $tl.query.text delete 0.0 end
    $tl.query.text insert end $query
    $tl.query.text config -state disabled

    return
}

##=========================================================================
## Name: HandleTimeString
##
## Description:
##   Routine to check if the value specified for a numeric variable is really
##   a Tcl date-time string.
##   Returns the converted value (or the original value, if it was already
##   a number).
## 
## Parameters:
##   value -- value to be checked
##   tl -- Tk pathname for toplevel widget of "build query" dialog (optional)
##
## Usage:
##   HandleTimeString value tl
##
## Comments:
##   Called by BuildQuery; calls gpsTime to do the conversion.
##   If the conversion fails, clears the "query" text widget so that no
##   query will be submitted, even if the used had pressed the
##   "Refresh & Submit" button.

proc HandleTimeString { value {tl ""} } {

    set value [string trim $value]
    set gps -12349

    if { [string is double $value] } {

	set gps $value

    } else {

	set numletters [regsub -all {[A-Za-z]} $value {} ignore]

	;##- If there are no letters, slashes or colons, maybe this is an
	;##- arithmetic expression giving GPS seconds, so try to evaluate it.
	if { $numletters == 0 && ! [regexp {[/:]} $value] } {
	    if { ! [catch {expr $value} modvalue] } {
		if { [string is double $modvalue] } {
		    if { $modvalue > 100000000 } {
			set gps $modvalue
		    }
		}
	    }
	}

    }

    if { $gps == -12349 } {
	;##- Try to convert to GPS time, but only if the string contains
	;##- at least three letters OR a slash, colon, "am", or "pm"

	set origvalue $value

	;##- Special case to handle MJD (Jan 1, 1970 0:00 UTC = MJD 40587)
	if { ( [regexp -nocase {^mjd *(\S+) *$} $value - mjdtime] || \
		   [regexp -nocase {^ *(\S+) *mjd$} $value - mjdtime] ) \
		 && [string is double $mjdtime] } {
	    if { $mjdtime >= 40587 } {
		set systime [expr {int(round(86400*($mjdtime-40587.0)))}]
		set value [clock format $systime -gmt 1]
	    } else {
		set value "mjd"
	    }
	}

	;##- Modify string to avoid a counterintuitive case: Tcl considers
	;##- "jan 23 2003" to be "jan 23 20:03", but I want it to be
	;##- interpreted as "jan 23, 2003".
	regsub -nocase {([a-z]{3,}\s+\d{1,2})\s+((?:19|20)\d\d)} $value \
		{\1, \2} value

	;##- Another special case: allow the form "jan 23, 20:03"
	regsub -nocase {([a-z]{3,}\s+\d{1,2})\s*,\s+(\d{1,2}:\d{1,2})} $value \
		{\1 \2} value

	;##- If input string begins with a date/time and ends with a relative
	;##- number, assume it is a number of seconds
	if { [regexp {[^\d\s\+\-\*/].*[+-]\s*[\d\*]+$} $value] } {
	    append value "sec"
	}

	;##- If it just ends with "s", also assume this is seconds
	if { [regexp {[^\d\s\+\-\*/].*[+-]\s*[\d\*]+\s*s\s*$} $value] } {
	    set value [string trim $value]
	    append value "ec"
	}

	if { ( $numletters < 3 && ! [regexp -nocase {(/|:|am|pm)} $value] ) \
		|| [catch {gpsTime $value} work] } {

	    ;##- Conversion failed!

	    if { ! [string is space $tl] } {
		;##- Clear the query text widget
		$tl.query.text config -state normal
		$tl.query.text delete 0.0 end
		$tl.query.text insert end ""
		$tl.query.text config -state disabled
		;##- Also clear the estimate area (if it exists)
		if { [winfo exists $tl.est] } { $tl.est config -text "\n" }

		;##- Report the error
		set ignore [ tk_messageBox -type ok -icon error -parent $tl \
			-title "Invalid number or date-time string" \
			-message "\"$origvalue\" is not a number or a\
			valid Tcl date-time string" ]
	    }

	    ;##- Return with an error condition
	    return -code error "invalid"
	}
	set gps $work

	;##- If U.S. time zone was specified, check daylight vs. standard time
	;##- (Unix only)
	if { [regexp -nocase {(?:\A|[^y])([ecmp][sd]t)} $value match inzone] \
		&& ! [regexp -nocase {(windows|macos|darwin)} \
		$::tcl_platform(os)] } {
	    set inzone [string toupper $inzone]
	    set inzone1 [string index $inzone 0]

	    switch -exact -- $inzone1 {
		"E" { set checkTZ "EST5EDT" }
		"C" { set checkTZ "CST6CDT" }
		"M" { set checkTZ "MST7MDT" }
		"P" { set checkTZ "PST8PDT" }
	    }

	    if { [info exists ::env(TZ)] } {
		set saveZone $::env(TZ)
	    } else {
		set saveZone ""
	    }

	    set tzChanged 0
	    if { ! [string equal $saveZone $checkTZ] } {
		set ::env(TZ) $checkTZ
		set tzChanged 1
	    }

	    set outzone [clock format [utcTime $gps] -format %Z]

	    if { $tzChanged } {
		;##- Restore the original time zone
		if { $saveZone != "" } {
		    set ::env(TZ) $saveZone
		} else {
		    unset ::env(TZ)
		}
	    }

	    if { ! [string equal $inzone $outzone] } {
		if { ! [string is space $tl] } {
		    ;##- Clear the query text widget
		    $tl.query.text config -state normal
		    $tl.query.text delete 0.0 end
		    $tl.query.text insert end ""
		    $tl.query.text config -state disabled
		    ;##- Also clear the estimate area (if it exists)
		    if { [winfo exists $tl.est] } { $tl.est config -text "\n" }

		    ;##- Report the error
		    set modvalue $origvalue
		    if {! [regsub -nocase " $inzone" $origvalue "" modvalue]} {
			regsub -nocase $inzone $origvalue "" modvalue
		    }
		    set ignore [ tk_messageBox -type ok -icon error \
			    -parent $tl \
			    -title "Time does not occur during $inzone" \
			    -message "\"$modvalue\" does not occur\
			    during $inzone" ]
		}

		;##- Return with an error condition
		return -code error "That time does not occur during $inzone"
	    }
	}

    }

    ;##- Check that the GPS time is reasonable
    if { [string is space $gps] } {
	set gps ""

    } elseif { [string is double $value] && [regexp {^-?\d{1,10}$} $value] } {

	if { [regexp {^\d{1,9}$} $value] && \
		$gps < 440000000 && $gps != 0 && $gps != 1 } {

	    if { ! [string is space $tl] } {
		;##- Clear the query text widget
		$tl.query.text config -state normal
		$tl.query.text delete 0.0 end
		$tl.query.text insert end ""
		$tl.query.text config -state disabled
		;##- Also clear the estimate area (if it exists)
		if { [winfo exists $tl.est] } { $tl.est config -text "\n" }

		;##- Report the error
		set ignore [ tk_messageBox -type ok -icon error -parent $tl \
			-title "Unreasonable GPS time" \
			-message "GPS time $gps is prior to 1994;\
			you probably left out one or more digits" ]
	    }

	    ;##- Return with an error condition
	    return -code error "pre-1994"

	} elseif { $gps > 1830000000 || [regexp {^[2-9]\d{9,}$} $value] } {

	    if { ! [string is space $tl] } {
		;##- Clear the query text widget
		$tl.query.text config -state normal
		$tl.query.text delete 0.0 end
		$tl.query.text insert end ""
		$tl.query.text config -state disabled
		;##- Also clear the estimate area (if it exists)
		if { [winfo exists $tl.est] } { $tl.est config -text "\n" }

		;##- Report the error
		set ignore [ tk_messageBox -type ok -icon error -parent $tl \
			-title "Unreasonable GPS time" \
			-message "GPS time $gps is after 2037" ]
	    }

	    ;##- Return with an error condition
	    return -code error "post-2037"

	}

    }

    ;##- Return the converted value
    return $gps
}

##=========================================================================
## .
## The following proc was copied from /ldas/ldas-0.0/stow_pkgs/ldas-0.0.7/
## lib/genericAPI/genericAPI.tcl on 19 Jan 2000 by Peter Shawhan
## ******************************************************** 
##
## Name: gpsTime
##
## Description:
## Given a GMT or UNIX epoch time, return GPS time.
## If no argument is given, return current GPS time.
##
## Parameters:
## time - UNIX epoch seconds, or a date and time: "01/06/80 01:01:01"
##
## Usage:
##         set gpstime [ gpsTime "04/20/99 01:20:59" ]
##     or  set gpstime [ gpsTime 91232121 ]
##     or  set gpstime [ gpsTime 01/20/01 ]
##     or  set gpstime [ gpsTime 01/20/2001 ]
##     or  set gpstime [ gpsTime now ]
##
## Comments:
## This procedure must be manually updated when a new
## leap-second is added.  see:
## ftp://tycho.usno.navy.mil/pub/series/ser14.txt
## The GPS epoch started at 0 at 02/06/80 00:00:00 GMT.
## Should put leap seconds in a separate file and check
## daily for updates.

proc gpsTime { { time "" } } {

     if { ! [info exists ::gpsTimeEpochDiff] } {
	;## Calculate the difference between the UNIX epoch and GPS epoch.
	set epochdiff [expr {[clock scan "jan 1, 1970 0:00 gmt"] + 315964819}]
	set ::gpsTimeEpochDiff $epochdiff
     } else {
	set epochdiff $::gpsTimeEpochDiff
     }

     ;## 1972-01-01 00:00:00 UTC was 1972-01-01 00:00:10 TAI.
     set offset 10

     if { ! [info exists ::gpsTimeLeapSecs] } {
	 ;## assumes 00:00:00.
	 set leapdates {
                   07/01/1972
                   01/01/1973
                   01/01/1974
                   01/01/1975
                   01/01/1976
                   01/01/1977
                   01/01/1978
                   01/01/1979
                   01/01/1980
                   07/01/1981
                   07/01/1982
                   07/01/1983
                   07/01/1985
                   01/01/1988
                   01/01/1990
                   01/01/1991
                   07/01/1992
                   07/01/1993
                   07/01/1994
                   01/01/1996
                   07/01/1997
                   01/01/1999
                   01/01/2006
                   01/01/2009
                   }
                  
	;## build the lookup table in gmt seconds
	set ::gpsTimeLeapSecs {}
	foreach date $leapdates {
	    lappend ::gpsTimeLeapSecs [ clock scan $date -gmt 1 ]
	}
	set ::gpsTimeLeapSecs [lsort -integer $::gpsTimeLeapSecs]
    }     
    set leapsecs $::gpsTimeLeapSecs

     ;## quick short-circuit for "now".
     if { $time == "now" } {
        set time [ clock seconds ]
        set fudge [ expr { $offset + [ llength $leapsecs ] } ]
        return [ expr { $time - $epochdiff + $fudge } ]
        }

     ;## canonicalise input to UNIX epoch seconds
     if { ! [ regexp {^-?[0-9]+$} $time ] } {
        if { [ catch {
           set time [ clock scan $time -gmt 1 ]
           } err ] } {
           return -code error $err
           }
        }   

     foreach sec $leapsecs {
          if { $time <= $sec } {
             set index [ lsearch $leapsecs $sec ]
             break;
             }
          ;## if we fall off the end of the list   
          set index [ llength $leapsecs ]
          }   
     set offset  [ expr { $offset + $index } ] 
     set gpstime [ expr { $time - $epochdiff + $offset } ]
     return $gpstime
}

##=========================================================================
## .
## The following proc was copied from /ldas/ldas-0.0/stow_pkgs/ldas-0.0.8/
## lib/genericAPI/genericAPI.tcl on 17 Feb 2000 by Peter Shawhan
## ******************************************************** 
##
## Name: utcTime
##
## Description:
## Converts GPS epoch time to UNIX epoch time
##
## Parameters:
## time - GPS time in GPS seconds, leap second corrected
##
## Usage:
##        set utctime [ utcTime gpsTime ]
##
## Comments:
## This is what happens when you adopt GPS time as your
## standard!  grumble grumble...
## Yes, it is right -- try "clock format [ utcTime 0 ] -gmt 1"

proc utcTime { { time "" } } {
     
     if { ! [ regexp {^-?[0-9]+$} $time ] } {
        return -code error "utcTime requires integer argument"
        }
     
     if { ! [info exists ::utcTimeEpochDiff] } {
	;## Calculate the difference between the UNIX epoch and GPS epoch.
	set epochdiff [expr {[clock scan "jan 1, 1970 0:00 gmt"] + 315964819}]
	set ::utcTimeEpochDiff $epochdiff
     } else {
	set epochdiff $::utcTimeEpochDiff
     }

     ;## 1972-01-01 00:00:00 UTC was 1972-01-01 00:00:10 TAI.
     set offset 10

     if { ! [info exists ::utcTimeLeapSecs] } {
	 ;## assumes 00:00:00.
	 set leapdates {
                   07/01/1972
                   01/01/1973
                   01/01/1974
                   01/01/1975
                   01/01/1976
                   01/01/1977
                   01/01/1978
                   01/01/1979
                   01/01/1980
                   07/01/1981
                   07/01/1982
                   07/01/1983
                   07/01/1985
                   01/01/1988
                   01/01/1990
                   01/01/1991
                   07/01/1992
                   07/01/1993
                   07/01/1994
                   01/01/1996
                   07/01/1997
                   01/01/1999
                   01/01/2006
                   01/01/2009
                   }
                   
	 set ::utcTimeLeapSecs {}
	 foreach date $leapdates {              
	     lappend ::utcTimeLeapSecs [ gpsTime $date ]
	 }
	 set ::utcTimeLeapSecs [lsort -integer $::utcTimeLeapSecs]
     }
     set leapsecs $::utcTimeLeapSecs

     foreach sec $leapsecs {
          if { $time <= $sec } {
             set index [ lsearch $leapsecs $sec ]
             break;
             }
          ;## if we fall off the end of the list   
          set index [ llength $leapsecs ]
          }   
     set offset  [ expr { $offset + $index } ] 
     set utctime [ expr { $time + $epochdiff - $offset } ]
     return $utctime
}


##=========================================================================
## Name: EntryAddAnd
##
## Description:
##   Appends the string " AND " after the current contents of an entry widget,
##   unless it is already somewhere in the contents.
## 
## Parameters:
##   w -- Tk pathname of entry widget
##
## Usage:
##   EntryAddAnd w
##
## Comments:
##   Called when the numeric comparison is set to "between" on the optionmenu
##   associated with this entry widget.

proc EntryAddAnd { w } {

    ;##- Get the current contents of the entry widget
    set curtext [$w get]

    ;##- If the entry already contains an AND, just return
    if {[regexp -nocase "and" $curtext]} { return }
    
    ;##- Append AND at the end of the entry text
    $w insert end " AND "

    return
}

##===========================
## Name: EntryRemoveAnd
##
## Description:
##   Removes the word "AND", along with any following text, from the
##   contents of an entry widget.
## 
## Parameters:
##   w -- Tk pathname of entry widget
##
## Usage:
##   EntryRemoveAnd w
##
## Comments:
##   Called when the numeric comparison is set to anything OTHER THAN
##  "between" on the optionmenu associated with this entry widget.

proc EntryRemoveAnd { w } {

    ;##- Get the current contents of the entry widget
    set curtext [$w get]

    ;##- If the entry contains an AND, remove it and everything that follows
    if { [regsub -nocase {\s*and.*} $curtext "" newtext] } {
	$w delete 0 end
	$w insert end $newtext
    }

    return
}

##=========================================================================
## Name: KeyModifiesEntry
##
## Description:
##   Returns 1 if the key just pressed modifies the contents of an entry
##   widget, e.g. if it is an alphanumeric key or BackSpace or Delete.
##   Returns 0 otherwise.
## 
## Parameters:
##   keysym -- keysym of the key just pressed (%K for the event)
##   asym -- printing character for the key just pressed (%A for the event)
##
## Usage:
##   KeyModifiesEntry keysym asym
##
## Comments:
##   Used for some bindings which are set up so that a change to the
##   contents of an entry widget automatically activates the associated
##   checkbutton or radiobutton.

proc KeyModifiesEntry { keysym asym } {
###    puts "keysym is $keysym, asym is $asym"
    ;##- This function determines whether a given keysym makes any change
    ;##- to the contents of an entry widget
    if { $keysym == "Tab" || $keysym == "Return" } { return 0 }
    if { $keysym=="BackSpace" || $keysym=="Delete" } { return 1 }
    if { [string length $asym] > 0 } {
	return 1
    } else {
	return 0
    }

    return
}

##=========================================================================
## Name: BuildDataQueryDialog
##
## Description:
##   Main routine to construct a "build query" dialog, with buttons and
##   entry widgets to allow the user to determine the query.
##
## Parameters:
##   ?options? -- See Usage and Comments
##
## Usage:
##   BuildDataQueryDialog  ?-preset var=value? ?-preset var=value? ...
##
## Comments: (TODO: change the comments)
##   Any "-preset" option is used to initialize the appropriate
##   sections in the query dialog.  For example, if called with 
##   "-preset start_time=632451347", then the start_time is
##   initially set to be required to be equal to 632451347.  There can be
##   more than one "-preset"; they are processed sequentially.
##
##   The "Submit" button calls BuildDataQuery to build manager query
##   according to the current settings and insert the query into the text
##   widget near the bottom of the dialog, then calls ManagerSubmit to
##   execute the query.

proc BuildDataQueryDialog { args } {

    ;##- Freeze the LDAS server
    set title "Build Frame Data Request -- $::dbname"

    ;##- Check options
    set presets {}
    foreach { opt optval } $args {
	switch -- $opt {
	    -preset { lappend presets $optval }
	}
    }

    ;##- Create a new window for input
    set tl [NewToplevel]
    wm title $tl $title

    if {$::winIcons} {
	;##- Also create an icon for this window
	NewToplevel ${tl}Icon -icon -width 48 -height 48 -highlightthickness 0
	label ${tl}Icon.bitmap -image buildqueryIcon
	pack ${tl}Icon.bitmap -side top -fill x
	wm iconwindow $tl ${tl}Icon
	wm iconname $tl "Raw - $::dbname"
    }

    ;##- Declare some global variables specific to this dialog
    set tlbase [string range $tl 1 end]
    global server$tlbase checkbutton$tlbase entry$tlbase resamp$tlbase \
	    disposition$tlbase
    set server$tlbase $::dbname
    set disposition$tlbase "file"

    ;##----------- Label area (at top)

    label $tl.label -text $title -pady 10
    pack $tl.label -side top -fill x

    ;##----------- Button area (at bottom)

    frame $tl.barea

    button $tl.barea.submit -text "Submit" \
	    -command [selsub {
	BuildDataQuery $tl
	set dataCmd [ $tl.query.text get 1.0 "end -1 chars" ]
	if { $dataCmd != "" } {
	    lappend ::globalDgetHistory $dataCmd
            ManagerSubmit $dataCmd $disposition$tlbase -dbname $server$tlbase
	}
    } tl tlbase]

    button $tl.barea.help -text "Help" -command ShowRawDataHelp
    button $tl.barea.close -text "Close" \
	    -command "if {\[winfo exists ${tl}Icon\]} {destroy ${tl}Icon};\
	    destroy $tl"
    grid $tl.barea.submit $tl.barea.help $tl.barea.close -padx 10 -pady 2
    pack $tl.barea -side bottom -fill x

    ;##----------- Output disposition (at bottom)
    frame $tl.disposition
    radiobutton $tl.disposition.download -text "Download output" -pady 0 \
	    -variable disposition$tlbase -value "file"
    radiobutton $tl.disposition.url -text "Report URL(s) of output" -pady 0 \
	    -variable disposition$tlbase -value "jobmessage"
    grid $tl.disposition.download $tl.disposition.url -padx 10
    pack $tl.disposition -side bottom -fill x

    ;##----------- Query area (at bottom)

    ;##- Area to display size & time estimates
    message $tl.est -justify left -aspect 10000 -text "\n" \
	    -foreground blue -anchor w
    pack $tl.est -side bottom -fill x

    frame $tl.query
    scrollbar $tl.query.yscroll -orient vertical \
	    -command "$tl.query.text yview"
    text $tl.query.text -width 64 -height 5 -wrap word -state disabled \
	    -yscrollcommand "$tl.query.yscroll set"
    bind $tl.query.text <Button> "focus %W"

    grid $tl.query.text $tl.query.yscroll -sticky news
    grid rowconfigure $tl.query 0 -weight 1
    grid columnconfigure $tl.query 0 -weight 1
    grid $tl.query -sticky news
    pack $tl.query -side bottom -fill both -expand true

    ;##----- Heading above query area
    frame $tl.queryhead
    label $tl.queryhead.label -text "Built data request:   " -font boldfont
    button $tl.queryhead.refresh -text "Refresh" -pady 0 -default active \
	    -command "BuildDataQuery $tl"
    pack $tl.queryhead.label -side left
    pack $tl.queryhead -side bottom -fill x

    ;##- Set up bindings to refresh query after ANY user action!
    bind $tl <Key> "BuildDataQuery $tl"
    bind $tl <ButtonRelease> "BuildDataQuery $tl"

    ;##----- Data type selection area

    frame $tl.type
    label $tl.type.label -text "Data type:" -font boldfont
    set entry$tlbase "R"
    entry $tl.type.entry -width 25 -textvariable entry$tlbase
    button $tl.type.list -text "List data types" -pady 0 -state disabled \
	    -command "ListDataTypes $tl"

    ;##- Lay out the widgets
    pack $tl.type.label -side left
    pack $tl.type.entry -side left
    pack $tl.type.list -side left
    pack $tl.type -side top -fill x

    ;##----------- Channel list area

    frame $tl.chanlist
    label $tl.chanlist.label -text "                " -font boldfont
    button $tl.chanlist.list -text "List channels" -pady 0 \
 	    -command "GetChannelList $tl"
    label $tl.chanlist.label2 -text "at time:"
    entry $tl.chanlist.attime
    $tl.chanlist.attime insert end "latest available"

    ;##- Lay out the widgets
    pack $tl.chanlist.label -side left
    pack $tl.chanlist.list -side left
    pack $tl.chanlist.label2 -side left
    pack $tl.chanlist.attime -side left -fill x -expand true
    pack $tl.chanlist -side top -fill x

    ;##- Detector selection

    frame $tl.ifos
    label $tl.ifos.label -text "                                 from site:"
    pack $tl.ifos.label -side left
    set ifolist $::frame_prefix([set server$tlbase])
    foreach ifo $ifolist {
	set w $tl.ifos.[string tolower $ifo]
	radiobutton $w -variable "checkbutton$tlbase\(ifo\)"\
		-value $ifo -text "$ifo " -padx 0 -pady 0
	pack $w -side left
    }
    radiobutton $tl.ifos.other -variable "checkbutton$tlbase\(ifo\)"\
	    -value "other" -text "Other:" -padx 0 -pady 0
    entry $tl.ifos.entry -textvariable otherifo$tlbase -width 4
    pack $tl.ifos.other -side left
    pack $tl.ifos.entry -side left

    set checkbutton$tlbase\(ifo\) [lindex $ifolist 0]

    pack $tl.ifos -side top -fill x

    ;##- Set up bindings so that the entry widget can change the radiobutton
    bind $tl.ifos.entry <Key> [selsub {
	if {[KeyModifiesEntry %K %A]} {
	    set checkbutton$tlbase(ifo) "other"
	}
    } tlbase ]

    bind $tl.ifos.entry <Button-2> [selsub {
	if {[KeyModifiesEntry %K %A]} {
	    set checkbutton$tlbase(ifo) "other"
	}
    } tlbase ]

    bind $tl.ifos.entry <KeyRelease-BackSpace> [selsub {
	if {[$tl.ifos.entry get] == ""} {
	    set checkbutton$tlbase(ifo) "other"
	}
    } tl tlbase ]

    bind $tl.ifos.entry <KeyRelease-Delete> [selsub {
	if {[$tl.ifos.entry get] == ""} {
	    set checkbutton$tlbase(ifo) "other"
	}
    } tl tlbase ]

    bind $tl.ifos.entry <Control-KeyRelease-d> [selsub {
	if {[$tl.ifos.entry get] == ""} {
	    set checkbutton$tlbase(ifo) "other"
	}
    } tl tlbase ]


    ;##----------- Signal selection area

    ;##- Create a label, entry and list widget
    frame $tl.sigsel
    label $tl.sigsel.label -text "Channel(s):" -font boldfont
    entry $tl.sigsel.entry

    ;##- Lay out the signal selection area
    pack $tl.sigsel.label -side left
    pack $tl.sigsel.entry -fill x -expand true -side left
    pack $tl.sigsel -side top -fill x

    ;##- Resampling factor section
    frame $tl.resamp
    label $tl.resamp.pad -text "             " -font normfont
    radiobutton $tl.resamp.raw -variable "checkbutton$tlbase\(chantype\)"\
		-value "Adc" -text "Raw ADC " -padx 0 -pady 0
    radiobutton $tl.resamp.proc -variable "checkbutton$tlbase\(chantype\)"\
		-value "Proc" -text "Proc " -padx 0 -pady 0
    set checkbutton$tlbase\(chantype\) "Adc"
    label $tl.resamp.label -text "     Down-sampling factor:" \
	    -font normfont
    set menu [tk_optionMenu $tl.resamp.menu resamp$tlbase none 2 4 8 16 ]
    for {set index 0} {$index <= [$menu index end]} {incr index} {
	$menu entryconfigure $index -command "BuildDataQuery $tl"
    }
    $tl.resamp.menu config -pady 0

    pack $tl.resamp.pad $tl.resamp.raw $tl.resamp.proc \
	    $tl.resamp.label $tl.resamp.menu -side left
    pack $tl.resamp -side top -fill x

    ;##----------- Times selection area

    ;##- Create a label and an entry widget
    frame $tl.start_time
    label $tl.start_time.label -text "Start Time:" -font boldfont
    entry $tl.start_time.entry

    ;##- Lay out time selection area
    pack $tl.start_time.label -side left
    pack $tl.start_time.entry -fill x -expand true -side left
    pack $tl.start_time -side top -fill x

    ;##- Create a label and an entry widget
    frame $tl.end_time
    label $tl.end_time.label -text "\[End Time\]:" -font boldfont
    entry $tl.end_time.entry

    ;##- Lay out time selection area
    pack $tl.end_time.label -side left
    pack $tl.end_time.entry -fill x -expand true -side left
    pack $tl.end_time -side top -fill x

    ;##- Create an area to display the available time range
    frame $tl.avail_time
    label $tl.avail_time.label -text "Data types and most recent time:"
    entry $tl.avail_time.times -relief flat -highlightcolor $::bgColor
    bind $tl.avail_time.times <Button> "focus %W"
    $tl.avail_time.times insert end "(not yet checked)"
    $tl.avail_time.times configure -state $::entrydis
    button $tl.avail_time.check -text "Check" -pady 0 \
	    -command "CheckFrameCache $tl [set server$tlbase]"
    button $tl.avail_time.details -text "Details" -pady 0 \
	    -state disabled -command "ShowCacheDetails $tl"
##    ;##- Queue an event to go ahead and check the time range
##    after 0 [list $tl.avail_time.check invoke]

    ;##- Lay out available-time-range area
    pack $tl.avail_time.check -side left
    pack $tl.avail_time.label -side left
    pack $tl.avail_time.details -side right
    pack $tl.avail_time.times -side left -fill x -expand true
    pack $tl.avail_time -side top -fill x


    ;##----------- Output frame type specification area

    frame $tl.outtype
    label $tl.outtype.label -text "Type string in output frames:" \
	-font boldfont
    radiobutton $tl.outtype.auto -variable "checkbutton$tlbase\(outtype\)" \
	-value "auto" -text "Automatic " -padx 0 -pady 0
    set checkbutton$tlbase\(outtype\) "auto"
    radiobutton $tl.outtype.custom -variable "checkbutton$tlbase\(outtype\)" \
	-value "custom" -text "Custom:" -padx 0 -pady 0
    entry $tl.outtype.entry -textvariable outtype$tlbase
    pack $tl.outtype.label $tl.outtype.auto $tl.outtype.custom -side left
    pack $tl.outtype.entry -side left -fill x -expand true
    pack $tl.outtype -side bottom -fill x

    ;##- Set up bindings so that the entry widget can change the radiobutton
    bind $tl.outtype.entry <Key> [selsub {
	if {[KeyModifiesEntry %K %A]} {
	    set checkbutton$tlbase(outtype) "custom"
	}
    } tlbase ]

    bind $tl.outtype.entry <Button-2> [selsub {
	if {[KeyModifiesEntry %K %A]} {
	    set checkbutton$tlbase(outtype) "custom"
	}
    } tlbase ]

    bind $tl.outtype.entry <KeyRelease-BackSpace> [selsub {
	if {[$tl.outtype.entry get] == ""} {
	    set checkbutton$tlbase(outtype) "custom"
	}
    } tl tlbase ]

    bind $tl.outtype.entry <KeyRelease-Delete> [selsub {
	if {[$tl.outtype.entry get] == ""} {
	    set checkbutton$tlbase(outtype) "custom"
	}
    } tl tlbase ]

    bind $tl.outtype.entry <Control-KeyRelease-d> [selsub {
	if {[$tl.outtype.entry get] == ""} {
	    set checkbutton$tlbase(outtype) "custom"
	}
    } tl tlbase ]

    ;##----- Empty frame to put some space above the output frame type area
    frame $tl.outtypepad -height 12
    pack $tl.outtypepad -side bottom -fill x


    ;##----------- Concatenation option selection


    set a [selsub {
	if { $checkbutton$tlbase(frameop) == "get" || \
		$checkbutton$tlbase(frameop) == "cat" } {
	    $tl.frameopsel.frame configure -state normal
	} else {
	    $tl.frameopsel.frame configure -state disabled
	    if { $checkbutton$tlbase(retformat) == "frame" } {
		$tl.frameopsel.ligo_lw invoke
	    }
	}
	if { $checkbutton$tlbase(frameop) == "cat" } {
	    $tl.frameopsel.gaps.label configure -foreground black
	    $tl.frameopsel.gaps.yes configure -state normal
	    $tl.frameopsel.gaps.no configure -state normal
	} else {
	    $tl.frameopsel.gaps.label configure -foreground gray50
	    $tl.frameopsel.gaps.yes configure -state disabled
	    $tl.frameopsel.gaps.no configure -state disabled
	}

    } tlbase tl]
    
    frame $tl.frameopsel
    label $tl.frameopsel.label -text " Operation:" -font boldfont
    radiobutton $tl.frameopsel.get -variable "checkbutton$tlbase\(frameop\)" \
	    -value get -text "Get frame data" -pady 0 -command $a
    $tl.frameopsel.get select 
    radiobutton $tl.frameopsel.elem -variable "checkbutton$tlbase\(frameop\)" \
	    -value elem -text "Get frame elements" -pady 0 -command $a
    radiobutton $tl.frameopsel.cat -variable "checkbutton$tlbase\(frameop\)" \
	    -value cat -text "Concatenate frames" -pady 0 -command $a

    ;##- Make an area to indicate whether or not to allow gaps
    frame $tl.frameopsel.gaps
    label $tl.frameopsel.gaps.label -text "   Allow gaps?" -foreground gray50
    radiobutton $tl.frameopsel.gaps.yes \
	    -variable "checkbutton$tlbase\(allowgaps\)"\
	    -value Y -text "Y " -padx 0 -pady 0 -state disabled
    radiobutton $tl.frameopsel.gaps.no \
	    -variable "checkbutton$tlbase\(allowgaps\)"\
	    -value N -text "N " -padx 0 -pady 0 -state disabled
    $tl.frameopsel.gaps.no select
    pack $tl.frameopsel.gaps.label $tl.frameopsel.gaps.yes \
	    $tl.frameopsel.gaps.no -side left

    #-- Return format

    set b [selsub {
	if { $checkbutton$tlbase(retformat) == "frame" } {
	    $tl.outtype.label configure -foreground black
	    $tl.outtype.auto configure -state normal
	    $tl.outtype.custom configure -state normal
	    $tl.outtype.entry configure -foreground black
	} else {
	    $tl.outtype.label configure -foreground gray50
	    $tl.outtype.auto configure -state disabled
	    $tl.outtype.custom configure -state disabled
	    $tl.outtype.entry configure -foreground gray50
	}
    } tlbase tl]

    label $tl.frameopsel.label1 -text " Format:" -font boldfont
    radiobutton $tl.frameopsel.frame \
	    -variable "checkbutton$tlbase\(retformat\)" \
	    -value frame -text "frame" -pady 0 -command $b
    radiobutton $tl.frameopsel.ligo_lw \
	    -variable "checkbutton$tlbase\(retformat\)" \
	    -value LIGO_LW -text "LIGO_LW" -pady 0 -command $b
    radiobutton $tl.frameopsel.ilwda \
	    -variable "checkbutton$tlbase\(retformat\)" \
	    -value "{ilwd ascii}" -text "ilwd ascii" -pady 0 -command $b
    radiobutton $tl.frameopsel.ilwdb \
	    -variable "checkbutton$tlbase\(retformat\)" \
	    -value "{ilwd binary}" -text "ilwd binary" -pady 0 -command $b
    set checkbutton$tlbase\(retformat\) "frame"

    grid $tl.frameopsel.label -row 0 -column 0 -sticky w
    grid $tl.frameopsel.get -row 0 -column 1 -sticky w
    grid $tl.frameopsel.elem -row 1 -column 1 -sticky w
    grid $tl.frameopsel.cat -row 2 -column 1 -sticky w
    grid $tl.frameopsel.gaps -row 3 -column 1 -columnspan 2 -sticky w

    grid $tl.frameopsel.label1 -row 0 -column 2 -sticky w
    grid $tl.frameopsel.frame -row 0 -column 3 -sticky w
    grid $tl.frameopsel.ligo_lw -row 1 -column 3 -sticky w
    grid $tl.frameopsel.ilwda -row 2 -column 3 -sticky w
    grid $tl.frameopsel.ilwdb -row 3 -column 3 -sticky w

    grid columnconfigure $tl.frameopsel 4 -weight 1
    pack $tl.frameopsel -side left


#      frame $tl.testframe
#      label $tl.testframe.label -text "Test:" -font boldfont
#      combobox::combobox $tl.testframe.combo
#      pack $tl.testframe.label -side left
#      pack $tl.testframe.combo -side left
#      pack $tl.testframe -side left


    ;##- Finally, set up a button to raise the main guild window
    button $tl.raise -text "main" -font normhelv -padx 0 -pady 0 \
	    -command "switch -- \[wm state .\] \
	    normal {raise .} iconic {wm deiconify .}; focus ."
    place $tl.raise -in $tl -relx 1 -rely 1 -anchor se


    ;##----------- Done setting up widgets

    ;##- Apply any presets (must be of the form "varname=value")
    foreach preset $presets {
###	puts "Applying preset $preset"
	set charpos [string first "=" $preset]
	if {$charpos > -1} {
	    ;##- Parse this to get the variable name and value
	    set varname [string tolower \
		    [string range $preset 0 [expr {$charpos-1}]]]
	    set value [string range $preset [expr {$charpos+1}] end]

	    ;##- Insert the value into the appropriate entry widget
	    set f $tl.$varname.entry
	    $f delete 0 end
	    $f insert end $value
	}
    }

    ;##- Build data query according to the initial settings
    BuildDataQuery $tl

    return
}


##=========================================================================
## Name: GetChannelList
##

proc GetChannelList { tl } {

    ;##- Get access to some global variables specific to this dialog
    set tlbase [string range $tl 1 end]
    upvar #0 server$tlbase server
    upvar #0 checkbutton$tlbase checkbutton
    upvar #0 entry$tlbase entry
    upvar #0 otherifo$tlbase otherifo

    ;##- Look up current settings in the dialog box
    set ifo $checkbutton(ifo)
    if { $ifo == "other" } { set ifo [string toupper $otherifo] }

    set type [string trim $entry]
    if { $type == "" } {
	set typearg ""
    } else {
	set typearg "-frametype $type"
    }

    #-- If cache info is known, check whether the user specified a valid
    #-- site/type combination
    if { [info exists ::cache$tlbase] } {
	upvar #0 cache$tlbase cache
	if { ! [info exists cache($ifo,$type,raw)] } {
	    tk_messageBox -icon error -type ok -title "No matching data" \
		    -parent $tl \
		    -message "No data found in frame cache for\
		    data type=$type, site=$ifo\nTry changing the data type\
                    and/or the site"
	    return
	}
    }

    set attime [string trim [$tl.chanlist.attime get]]
    if { [regexp -nocase {latest} $attime] || [string is space $attime] } {
	set timearg ""
	set descrip "Current channels ($ifo $type)"

	#-- The following block of code is needed to specify an explicit time
	#-- because of PR 1549
	if { [info exists ::cache$tlbase] } {
	    upvar #0 cache$tlbase cache
	    if { ! [info exists cache($ifo,$type,coalesced)] } {
		set cache($ifo,$type,coalesced) \
		    [SeglistCoalesce $cache($ifo,$type,raw)]
	    }

	    if { [llength $cache($ifo,$type,coalesced)] > 0 } {
		set latest [lindex [lindex $cache($ifo,$type,coalesced) end] 1]

		#-- Workaround for bug in LDAS 1.4.0, for which a time like
		#-- 791256063 matched TWO files, H-R-791256032-32.gwf and
                #-- H-R-791256064-32.gwf, leading to an LDAS error.
		set timearg "-time [expr {$latest-2}]"
	    } else {
		tk_messageBox -icon error -type ok -title "No matching data" \
			-parent $tl \
			-message "No data found in frame cache for\
			data type=$type, site=$ifo\nTry changing the data type\
                        and/or the site"
		return
	    }

	    set descrip "Channels ($ifo $type) as of $latest"

	} else {
	    #hack temporary (until LDAS is fixed)
	    tk_messageBox -icon info -type ok -title "Press the 'Check'\
                  button" -parent $tl -message "Currently, you must press the\
                  'Check' button to get frame cache info before you can list\
                  channels at the latest available time."
	    return
	}

    } elseif { [catch {HandleTimeString $attime} gps] } {
	tk_messageBox -icon error -type ok -title "Error parsing date/time" \
		-parent $tl \
		-message "Error parsing date/time string ($attime):\n$gps"
	return
    } else {
	set timearg "-time $gps"
	set descrip "Channels ($ifo $type) as of $attime"
    }

    set disp [ManagerSubmit \
	    "getChannels -returnprotocol http://daq\
	    -interferometer $ifo $typearg $timearg -metadata 1" \
	    channellistlistbox -dbname $server -description $descrip \
	    -lblinks "$tl.sigsel.entry" ]

    return
}


##=========================================================================
## Name: CheckFrameCache
##
## Description:
##   Retrieve the frame cache information and call UpdateFrameCache
## 
## Parameters:
##   tl -- Tk pathname for toplevel widget of "build raw data request" dialog
##   server -- Server to query
##
## Usage:
##   CheckFrameCache tl server

proc CheckFrameCache { tl server } {

    if { ! [winfo exists $tl] } return

    $tl.avail_time.times config -state normal
    $tl.avail_time.times delete 0 end
    $tl.avail_time.times config -state $::entrydis
    $tl.avail_time.label config -text "Getting frame cache info..."

    #-- Execute an LDAS job to get the frame-cache info
    ManagerSubmit "getFrameCache -returnprotocol http://cache.txt" \
	    [selsub {TCL UpdateFrameCache $tl _OUTPUT_} tl ] -dbname $server

    return
}


##=========================================================================
## Name: UpdateFrameCache
##
## Description:
##   Parse frame cache information and display it
## 
## Parameters:
##   tl -- Tk pathname for toplevel widget of "build raw data request" dialog
##   data -- Frame cache array dump from LDAS
##
## Usage:
##   UpdateFrameCache tl data

proc UpdateFrameCache { tl data } {

    set tlbase [string range $tl 1 end]
    upvar \#0 cache$tlbase cache
    catch { array unset cache }

    if { [catch {

	;##- Construct the frame cache
	set first 2000000000
	set last 0

	#-- Figure out whether this is the new format or the old format
	regexp -line {^.+$} $data firstline
	if { [llength $firstline] > 4 } {
	    #-- Old format
	    array set cachedat $data
	} else {
	    #-- New format
	    foreach line [split $data "\n"] {
		array set cachedat [list [lindex $line 0] [lrange $line 1 end]]
	    }
	}

    } errmsg ] } {

	if { [winfo exists $tl] } {
	    $tl.avail_time.times config -state normal
	    $tl.avail_time.times insert end "(error; try again)"
	    $tl.avail_time.times config -state $::entrydis
	    $tl.avail_time.label config -text "Most recent data:"
	    $tl.avail_time.check config -text Check
	}
	return
    }

    if { [info exists cachedat(dirs)] } {

	foreach dir $cachedat(dirs) {
	    foreach ifos $cachedat($dir,ifos) {
		foreach type $cachedat($dir,$ifos,types) {
		    foreach n $cachedat($dir,$ifos,$type,Ns) {
			foreach dt $cachedat($dir,$ifos,$type,dts) {
			    if { [info exists cachedat($dir,$ifos,$type,$n,$dt)] } {
				foreach {start end} $cachedat($dir,$ifos,$type,$n,$dt) {
				    #-- Update range list for each ifo
				    foreach ifo [split $ifos {}] {
					lappend cache($ifo,$type,raw) \
					    [list $start $end $dir]
				    }
				    #-- Update the overall range
				    if { $start < $first } { set first $start }
				    if { $end > $last } { set last $end }
				}
			    }
			}
		    }
		}
	    }
	}

    } else {
	#-- New disk cache format in LDAS 1.0

	foreach entry [ array names cachedat *,* ] {
	    foreach [ list dir ifo type nperfile dt ] [ split $entry , ] break
	    foreach [ list mtime N times ] [ set cachedat($entry) ] { break }
	    foreach [ list start end ] $times {
		lappend cache($ifo,$type,raw) [ list $start $end $dir ]
		#-- Update the overall range
		if { $start < $first } { set first $start }
		if { $end > $last } { set last $end }
	    }
	}

    }

    if { ! [winfo exists $tl] } return

    $tl.avail_time.times config -state normal
    $tl.avail_time.times insert end $last
    $tl.avail_time.times config -state $::entrydis
    $tl.avail_time.label config -text "Most recent data:"
    $tl.avail_time.check config -text Recheck
    if { ! [regexp {is empty} $last] } {
	$tl.avail_time.details config -state normal
	$tl.type.list config -state normal
    }

    return
}


##=========================================================================
## Name: ShowCacheDetails
##
## Description:
##   Pop up a window and display a condensed index of data in the frame cache.
## 
## Parameters:
##   tl -- Tk pathname for toplevel widget of "build raw data request" dialog
##
## Usage:
##   ShowCacheDetails tl

proc ShowCacheDetails { tl } {

    ;##- Get access to the list of cache info
    set tlbase [string range $tl 1 end]
    upvar #0 cache$tlbase cache

    if { [llength [array names cache]] == 0 } { return }

    set msg ""
    foreach key [lsort [array names cache *,raw ]] {
	regexp {^([^,]*),([^,]*),raw$} $key match ifo type

	#-- If this list has not yet been coalesced, do it now
	if { ! [info exists cache($ifo,$type,coalesced)] } {
	    set cache($ifo,$type,coalesced) \
		[SeglistCoalesce $cache($ifo,$type,raw)]
	}

	#-- Append the list contents to the output
	foreach item $cache($ifo,$type,coalesced) {
	    foreach {start end dirpat} $item {}
	    append msg "$ifo $type $start $end $dirpat\n"
	}

    }

    BigMessageBox -icon info -title "Frame cache summary" -message $msg \
	    -width 80 -xscroll 1

    return
}


##=========================================================================
## Name: SeglistCoalesce
##
## Description:
##   Coalesce a segment list into contiguous segments

proc SeglistCoalesce { inlist } {

    set inlist [lsort -index 0 $inlist]
    set outlist [list]
    set ostart 0
    set oend -1000000

    foreach item $inlist {
	foreach {start end dirpat} $item {}

	if { $start <= $oend } {
	    #-- Extend the current segment
	    if { $end > $oend } {
		set oend $end
	    }

	    #-- Update the directory pattern
	    set matched 0
	    set ipat -1
	    foreach odirpat $odirpats {
		incr ipat

		#-- If this pattern matches, break out of the loop
		if { [string match $odirpat $dirpat] } {
		    set matched 1
		    break
		}

		#-- break directory patterns into parts
		if { ! [regexp {^(/[^/]+)(/[^/]+)(/.*)$} $dirpat \
			    match first second rest] } {
		    regexp {^(/[^/]+)(.*)$} $dirpat match first second
		    set rest ""
		}
		if { ! [regexp {^(/[^/]+)(/[^/]+)(/.*)$} $odirpat \
			    match ofirst osecond orest] } {
		    regexp {^(/[^/]+)(.*)$} $odirpat match ofirst osecond
		    set orest ""
		}

		#-- Truncate pairs to be the same lengths
		set length1 [string length $first]
		set length2 [string length $ofirst]
		if { $length1 < $length2 } {
		    set firstlen $length1
		} else {
		    set firstlen $length2
		}
		set length1 [string length $second]
		set length2 [string length $osecond]
		if { $length1 < $length2 } {
		    set secondlen $length1
		} else {
		    set secondlen $length2
		}
		set length1 [string length $rest]
		set length2 [string length $orest]
		if { $length1 < $length2 } {
		    set restlen $length1
		} else {
		    set restlen $length2
		}

		#-- Figure out how much we would have to reduce lengths
		#-- to match
		set cutfirst 0
		if { ! [string equal $first $ofirst] } {
		    #-- Figure out which one is shorter
		    set length1 [string length $first]
		    set length2 [string length $ofirst]
		    if { $length1 < $length2 } {
			set firstlength $length1
		    } else {
			set firstlength $length2
		    }
		    #-- Trim off characters until we get a match
		    while { 1 } {
			incr cutfirst
			set endindex [expr {$firstlength-$cutfirst-1}]
			if { [string equal \
				  [string range $first 0 $endindex] \
				  [string range $ofirst 0 $endindex]] } \
			    break
		    }
		    #-- If first part of path differs at all, keep separate
		    if { $cutfirst > 0 } continue
		}
		    
		set cutsecond 0
		if { ! [string equal $second $osecond] } {
		    #-- Figure out which one is shorter
		    set length1 [string length $second]
		    set length2 [string length $osecond]
		    if { $length1 < $length2 } {
			set secondlength $length1
		    } else {
			set secondlength $length2
		    }
		    #-- Trim off characters until we get a match
		    while { 1 } {
			incr cutsecond
			set endindex [expr {$secondlength-$cutsecond-1}]
			if { [string equal \
				  [string range $second 0 $endindex] \
				  [string range $osecond 0 $endindex]] } \
			    break
		    }
		    #-- If second part of path differs much, keep separate
		    if { $cutsecond > 1 && $endindex < 3 } continue
		}

		set cutrest 0
		if { ! [string equal $rest $orest] } {
		    #-- Figure out which one is shorter
		    set length1 [string length $rest]
		    set length2 [string length $orest]
		    if { $length1 < $length2 } {
			set restlength $length1
		    } else {
			set restlength $length2
		    }
		    #-- Trim off characters until we get a match
		    while { 1 } {
			incr cutrest
			set endindex [expr {$restlength-$cutrest-1}]
			if { [string equal \
				  [string range $rest 0 $endindex] \
				  [string range $orest 0 $endindex]] } \
			    break
		    }
		    #-- If rest of path differs much, keep separate
		    if { $cutrest > 1 && $endindex < 3 } continue
		}

		#-- If we get here, then we found an acceptable pattern
		set matched 1

		#-- Now decide which part(s) to generalize
		if { $cutfirst } {
		    set endindex [expr {$firstlength-$cutfirst-1}]
		    set odirpat [string range $first 0 $endindex]
		    append odirpat "*"
		} else {
		    set odirpat $first
		}

		if { $cutsecond } {
		    set endindex [expr {$secondlength-$cutsecond-1}]
		    append odirpat [string range $second 0 $endindex]
		    append odirpat "*"
		} else {
		    append odirpat $second
		}

		if { $cutrest } {
		    set endindex [expr {$restlength-$cutrest-1}]
		    append odirpat [string range $rest 0 $endindex]
		    append odirpat "*"
		} else {
		    append odirpat $rest
		}

		#-- Update list of directory patterns
		set odirpats [lreplace $odirpats $ipat $ipat $odirpat]

		#-- We don't need to go through the remaining patterns
		break

	    }
	    #-- End loop over directory patterns

	    #-- If no existing directory pattern was matched well enough,
	    #-- add a new one
	    if { $matched == 0 } {
		lappend odirpats $dirpat
		#-- Sort so that /archive directories appear at the end
		set odirpats [lsort -decreasing $odirpats]
	    }

	} else {
	    #-- Flush out current item
	    if { $oend > 0 } {
		set pattext [join $odirpats ","]
		lappend outlist [list $ostart $oend $pattext]
	    }
	    set ostart $start
	    set oend $end
	    set odirpats [list $dirpat]
	}

    }

    #-- Flush out final item
    if { $oend > 0 } {
	set pattext [join $odirpats ","]
	lappend outlist [list $ostart $oend $pattext]
    }

    return $outlist
}


##=========================================================================
## Name: BuildDataQuery
##
## Description:
##   Routine to interrogate the widgets in the "build raw data request" dialog
##   and build the LDAS user command appropriately.
## 
## Parameters:
##   tl -- Tk pathname for toplevel widget of "build raw data request" dialog
##
## Usage:
##   BuildDataQuery tl
##
## Comments:
##   Puts the resulting query into a the "query" text widget near the bottom
##   of the "build raw data request" dialog.  Does NOT actually submit the
##   request; that is done by clicking the "Submit" button.

proc BuildDataQuery { tl } {
    set tlbase [string range $tl 1 end]
    global dbname checkbutton$tlbase entry$tlbase server$tlbase resamp$tlbase \
	outtype$tlbase

    upvar #0 checkbutton$tlbase checkbutton
    upvar #0 otherifo$tlbase otherifo

    if { ! [winfo exists $tl.start_time.entry] } { return }

    set start_time [$tl.start_time.entry get]
    set end_time [$tl.end_time.entry get]
    set query [$tl.sigsel.entry get]

    ;##- Convert to a comma-separated list, with proper resampling notation
    set channels [Uniquify $query [set resamp$tlbase]]
    if { [string is space $query] } {

	#-- "full()" does not seem to work any more
	##;##- "all" is a special case which just does a straight file copy
	##set query "full()"

	;##- Force user to specify a set of channels
	set errmsg "Specify channel(s)\n"

	if { [winfo exists $tl.est] } {
	    $tl.est config -text $errmsg -foreground red
	} else {
	    tk_messageBox -type ok -icon error -parent $tl \
		    -title "Bad time value" -message $errmsg
	}

	return

    } else {
	set chantype $checkbutton(chantype)
	set query "$chantype\($channels\)"
    }

    ;##- Check time strings
    set timeerr ""
    if { [catch {HandleTimeString $start_time} retval] } {
	set timeerr $retval
	set timeval $start_time
    } else {
	set start_time $retval
	if { [catch {HandleTimeString $end_time} retval] } {
	    set timeerr $retval
	    set timeval $end_time
	} else {
	    set end_time $retval
        if { ! [string is integer $start_time] || \
		     ! [string is integer $end_time] } {
		set timeerr "non-integer"
	    }
	}
    }

    if { $timeerr != "" } {

	;##- Clear the query text widget
	$tl.query.text config -state normal
	$tl.query.text delete 0.0 end
	$tl.query.text insert end ""
	$tl.query.text config -state disabled

	if { $timeerr == "pre-1994" } {
	    set errmsg "\"$timeval\" is an unreasonable GPS time\
		    (prior to 1994)\n"
	} elseif { $timeerr == "post-2037" } {
	    set errmsg "\"$timeval\" is an unreasonable GPS time\
		    (after 2037)\n"
	} elseif { [regexp {^That time does not occur during (.+$)} $timeerr \
		match tz] } {
	    regsub -nocase "\[^a-z\]$tz" $timeval {} timeval
	    set timeval [string trim $timeval]
	    set errmsg "\"$timeval\" does not occur during $tz\n"
    } elseif { $timeerr == "non-integer" } {
	    set errmsg "Start and end times cannot have fractional seconds\n"
	} elseif { [regexp {^[\d\*\+\-]+$} $timeval] } {
	    set errmsg "\"$timeval\" is not a valid GPS time\n"
	} else {
	    set errmsg "\"$timeval\" is not a valid date/time string\n"
	}

	if { [winfo exists $tl.est] } {
	    $tl.est config -text $errmsg -foreground red
	} else {
	    tk_messageBox -type ok -icon error -parent $tl \
		    -title "Bad time value" -message $errmsg
	}

	return
    }

    ;##- Make sure a start time was specified
    if { [string is space $start_time] } {
	;##- Clear the query text widget
	$tl.query.text config -state normal
	$tl.query.text delete 0.0 end
	$tl.query.text insert end ""
	$tl.query.text config -state disabled
	;##- Also clear the estimate area (if it exists)
	if { [winfo exists $tl.est] } { $tl.est config -text "\n" }

	;##- Display an error message if only an end time was specified
	if { $end_time != "" } {
	    if { [winfo exists $tl.est] } {
		$tl.est config -text "Start Time must be specified\n" \
			-foreground red
	    } else {
		tk_messageBox -type ok -icon error -parent $tl \
			-title "Missing start time" \
			-message "Start Time must be specified"
	    }
	}

	return
    }

    if { $end_time == "" } {
	set times $start_time
	set times_g $times
    } else {
	#-- Modify the end time for the LDAS job, since LDAS, by convention,
	#-- includes the full second of data which begins at the end time
	#-- you specify
	set end_time [expr {$end_time-1}]

	;##- Make sure end_time > start_time
	if { $end_time <= $start_time } {
	    ;##- Clear the query text widget
	    $tl.query.text config -state normal
	    $tl.query.text delete 0.0 end
	    $tl.query.text insert end ""
	    $tl.query.text config -state disabled

	    ;##- Report the error (in the estimate area, if it exists)
	    if { [winfo exists $tl.est] } {
		$tl.est config \
			-text "End Time must be later than Start Time\n" \
			-foreground red
	    } else {
		tk_messageBox -type ok -icon error -parent $tl \
			-title "Invalid time range" \
			-message "End Time must be later than Start Time"
	    }

	    return
	}

	set times "$start_time-$end_time"

	set times_g $times
	if { $checkbutton(frameop) == "cat" } {
	    ;##- If gaps are to be allowed, append to the time range
	    if { $checkbutton(allowgaps) == "Y" } {
		append times_g ":allow_gaps"
	    }
	}

    }

    if { $checkbutton(frameop) == "cat" } {
	set reqcmd concatFrameData
    } elseif { $checkbutton(frameop) == "elem" } {
	set reqcmd getFrameElements
    } else {
	set reqcmd getFrameData
    }

    ;##- See if a frametype is being specified
    set ftype [string trim [set entry$tlbase]]

    set retformat $checkbutton(retformat)

    ;##- Clear the query text widget, then insert the new query
    $tl.query.text config -state normal
    $tl.query.text delete 0.0 end

    set qsite {}
    #-- Workaround for bug in LDAS 1.0: Include site in framequery if user
    #-- specified an "Other" site
    if { $checkbutton(ifo) == "other" && [string length $otherifo] } {
	set qsite [string toupper $otherifo]
    }
    set cmd "$reqcmd -returnprotocol http://$retformat -outputformat $retformat\
	    -framequery {[list $ftype $qsite {} $times_g $query]}"

    $tl.query.text insert end $cmd
    $tl.query.text config -state disabled

    ;##---------
    ;##- Also update the estimate area
    set chanlist [regexp -all -inline {[^, ]+} $channels]
    $tl.est config -text [SizeAndTimeEstimates $reqcmd [set server$tlbase] \
	    $start_time $end_time "" $chanlist $retformat] \
	    -foreground blue

    return
}


##=========================================================================
## Name: Uniquify
##
## Description:
##   Removes duplicate items from a list (separated by spaces and/or commas)
##   and constructs a comma-separated string of the unique items.
## 
## Parameters:
##   string -- input string (list separated by spaces and/or commas)
##
## Usage:
##   set string [Uniquify $string]
##
## Comments:
##   Does not assume the list is sorted, and does not sort the output list.

proc Uniquify { string resamp } {

    #-- Convert to a list
    set list [regexp -all -inline {[^,\s]+} $string]
    set outl ""
    foreach item $list {
	set item [string trim $item]

	#-- If resampling was explicitly specified for this channel, tweak the
	#-- syntax if necessary.  Otherwise, use the default resampling factor
	#-- (if any)
	if { [regexp {^[^!]+!(\d+)!?$} $item match fac] || \
		[regexp -nocase {^[^!]+!resample!(\d+)!?$} $item match fac] } {
	    regsub {!.+$} $item "!resample!${fac}!" item
	} elseif { [regexp {!} $item] } {
	    append item {<INVALID_RESAMPLE_SYNTAX>}
	} elseif { $resamp != "none" } {
	    append item "!resample!${resamp}!"
	}

	#-- Add to list, unless already there
        if { [lsearch $outl $item] == -1 } {
	    lappend outl $item
	}
    }
    return [join $outl ","]
}


##=========================================================================
## Name: SizeAndTimeEstimates
##
## Description:
##   Calculates the estimated size of the output from a raw data request,
##   and a guess at how long the job will take.

proc SizeAndTimeEstimates {
    reqcmd server start_time end_time ifo channels retformat } {

    ;##- Estimate number of frames (assuming 16-second input frames)
    if { $end_time == "" } {
	set nframes 1
    } else {
	set nframes [expr {($end_time/16)-($start_time/16)+1}]
    }

    if { $reqcmd == "concatFrameData" && $end_time != "" } {
	set nframes_out [expr {($end_time-$start_time+1)/16.0}]
    } else {
	set nframes_out $nframes
    }

    ;##- Calculate estimated size in megabytes
    set uncert 0
    if { [llength $channels] == 0 } {
	switch -- $ifo {
	    "H" { set sizeEst [expr {77.1*$nframes_out}] }
	    "L" { set sizeEst [expr {44.5*$nframes_out}] }
	    default { set sizeEst 0.0; set uncert 1 }
	}
    } else {
	;##- Sum up data volume per second for each channel
	set bytesPerSec 0.0
	foreach channel $channels {
	    #-- Check for a down-sampling factor
	    if { ! [regexp {^([^!]+)!resample!(\d+)} $channel \
		    match channel fac] } {
		set fac 1
	    }
	    if { $fac <= 0 } {
	        set fac 1
		set uncert 1
	    }
	    regsub {!.*$} $channel {} channel
	    set value [ChannelBytesPerSec $channel]
	    if { $value == 0 } { set uncert 1 }
	    set bytesPerSec [expr {$bytesPerSec+$value/$fac}]
	}
	set sizeEst [expr {(0.006+16.0*$bytesPerSec/1000000.0)*$nframes_out}]
    }

    ;##- For ASCII output, mutiply the size by a factor of 3.6
    if { $retformat == "LIGO_LW" || $retformat == "{ilwd ascii}" } {
	set sizeEst [expr {3.6*$sizeEst}]
    }

    if { $sizeEst > 5.0 } {
	set sizeEstText [format "%.0f" $sizeEst]
    } elseif { $sizeEst > 0.5 } {
	set sizeEstText [format "%.1f" $sizeEst]
    } else {
	set sizeEstText [format "%.2f" $sizeEst]
    }
    if { $uncert } { append sizeEstText "+??" }
    set sizeEstText "Estimated output size:  $sizeEstText MB"

    ;##- Estimate job time in seconds
    set jobTime [expr {10+5*$nframes}]

    if { $retformat == "LIGO_LW" } {
	set jobTime [expr {$jobTime + int(3*$sizeEst)}]
    }

    ;##- Add in download time
    set time_fast [expr {$jobTime+int($sizeEst*6.5)+$nframes}]
    set time_t1 [expr {$jobTime+int($sizeEst*20.0)+$nframes}]
    set text_fast [expr {$time_fast/60}]:[format %02d [expr {$time_fast%60}]]
    set text_t1 [expr {$time_t1/60}]:[format %02d [expr {$time_t1%60}]]
    if { $uncert } { append text_fast "+??"; append text_t1 "+??" }

    set timeEstText "Estimated time:  "
    if { $server == "LHO" || $server == "LLO" } {
	append timeEstText \
		"$text_t1 if you are not at $server, $text_fast if you are"
    } else {
	append timeEstText $text_fast
    }

    return "$sizeEstText\n$timeEstText"
}



##=========================================================================
## Name: ChannelBytesPerSec
##
## Description:
##   Given a channel name, returns the data rate in bytes per second
##   (based on hard-coded pattern-matching).

proc ChannelBytesPerSec { chan } {

    ;##- For non-LIGO channels, return 0, which means "unknown"
    if { ! [regexp {^[HL][012]:} $chan] } { return 0 }

    #-- 16 kHz floating-point channels
    # ??:LSC-AS_[IQ], ??:LSC-POB_[IQ], ??:LSC-REFL_[IQ], ??:LSC-*_CTRL,
    # ??:LSC-CARM_TIDAL
    # ??:LSC-GPS_RAMP, ??:LSC-MC_L, ??:LSC-*_EXC_DAQ

    if { [regexp {^..:LSC-(AS|POB|REFL)_[IQ]$} $chan] || \
	    [regexp {^..:LSC-.+_(CTRL|EXC_DAQ)$} $chan] || \
	    [regexp {^..:LSC-CARM_TIDAL$} $chan] || \
	    [regexp {^..:LSC-MC_L$} $chan] } {
	return 65536
    }

    #-- 16 kHz short-integer channels
    # ??:GDS-IRIGB*, ?0:GDS-TEST_E?_0_12, ??:GDS-*_TO1, ??:GDS-*_DAC?,
    # ??:GDS-*_RAMP?, ??:GDS-*_TRIG?,
    # ??:PSL-FSS_FAST_F, ??:PSL-FSS_MIXERM_F, ??:PSL-FSS_PCDRIVE_F,
    # ??:PSL-PMC_ERR_F, ??:PSL-ISS_*_F, ??:IOO-MC_TO1, ??:IOO-MC_I, ??:IOO-MC_F
    # ??:LSC-*_DC, ??:LSC-MC_AO, ??:SUS-*_COIL_SUM, ??:DAQ-GPS*, H0:PEM-NBR_2K
    # ??:PSL-ISS_*_AC, ??:PSL-ISS_PDOUT_MON, ??:LSC-*_AC

    if { [regexp {^..:GDS-(IRIGB.+|TEST_E._0_12|.+_(TO1|DAC.|RAMP.|TRIG.))$} \
	    $chan] || \
	    [regexp {^..:PSL-FSS_(FAST|MIXERM|PCDRIVE)_F$} $chan] || \
	    [regexp {^..:PSL-(PMC_ERR|ISS_.+)_F$} $chan] || \
	    [regexp {^..:PSL-ISS_PDOUT_MON$} $chan] || \
	    [regexp {^..:(PSL|LSC)-.+_AC$} $chan] || \
	    [regexp {^..:LSC-(.+_DC|MC_AO)$} $chan] || \
	    [regexp {^..:IOO-MC_(TO1|I|F)$} $chan] || \
	    [regexp {^..:SUS-.+_COIL_SUM$} $chan] || \
	    [regexp {^..:DAQ-GPS} $chan] || $chan == "H0:PEM-NBR_2K" } {
	return 32768
    }

    #-- 2 kHz floating-point channels
    # ??:ASC-WFS?_[IQ][PY], ??:ASC-QPD?_[PY], ??:ASC-QPD?_DC,
    # ??:SUS-*_OPLEV_[PY]ERROR, ??:SUS-*_OPLEV_[PY]OUT

    if { [regexp {^..:ASC-(WFS._[IQ][PY]|QPD._[PY]|QPD._DC)$} $chan] || \
	    [regexp {^..:SUS-.+_OPLEV_[PY](ERROR|OUT)$} $chan] } {
	return 8192
    }

    #-- 2 kHz short-integer channels
    # ??:IOO-MC_L, ??:PSL-PMC_PZT_F, ??:PSL-FSS_SADRIVE_F, ??:PSL-QPD*_F,
    # ??:IOO-WFS*[PY], ??:IOO-MC?_[PY], ??:IOO-MC?_REF, ??:IOO-PSL_*_MON, 
    # ??:IOO-MCA_OUT_MON, ??:IOO-MC_*PD, ??:ASC-*_[PY],
    # ?0:PEM-*_ACC*, ?0:PEM-*_MAG*, ?0:PEM-*_MIC*, ?0:PEM-*_PWR1, ?0:PEM-*_V?,
    # ??:LSC-ETM?_CAL, ??:SUS-MC_LSC_INPUT, ??:SUS-*_COIL_[UL][LR],
    # ??:SUS-*_COIL_SIDE, H2:SUS-ETMX_SENSOR_[UL][LR], H1:SUS-*_SENSOR_[UL][LR],
    # H1:SUS-*_SENSOR_SIDE, L1:SUS-ETMX_SENSOR_SIDE,
    # ??:GDS-TEST_*, ?0:GDS-*_TO? (other than channels already matched)
    # ??:PSL-ISS_*_DC, ??:PSL-TEST*_F

    if { [regexp {^..:IOO-MC_L$} $chan] || \
	    [regexp {^..:PSL-(ISS_.+_DC|TEST.+_F)$} $chan] || \
	    [regexp {^..:PSL-(PMC_PZT|FSS_SADRIVE|QPD.+)_F$} $chan] || \
	    [regexp {^..:IOO-(WFS.+[PY]|MC._([PY]|REF)|(PSL_.+|MCA_OUT)_MON|MC_.+PD)$} $chan] || \
	    [regexp {^..:ASC-.+_[PY]$} $chan] || \
	    [regexp {^.0:PEM-.+_((ACC|MAG|MIC).*|PWR1|V[123])$} $chan] || \
	    [regexp {^..:LSC-ETM._CAL$} $chan] || \
	    [regexp {^..:SUS-MC_LSC_INPUT$} $chan] || \
	    [regexp {^..:SUS-.+_COIL_([UL][LR]|SIDE)$} $chan] || \
	    [regexp {^H2:SUS-ETMX_SENSOR_[UL][LR]$} $chan] || \
	    [regexp {^H1:SUS-.+_SENSOR_([UL][LR]|SIDE)$} $chan] || \
	    $chan == "L1:SUS-ETMX_SENSOR_SIDE" || \
	    [regexp {^..:GDS-(TEST_.+|.+_TO.)$} $chan] } {
	return 4096
    }

    #-- 256 Hz short-integer channels
    # ??:PSL-*_F, ??:IOO-MC_L, ?0:PEM-*_TILT?, ?0:PEM-*_SEIS?, ??:SUS-*_SENSOR_*,
    # ??:SEI-ETM?_FINE? (other than channels already matched)
    
    if { [regexp {^..:(PSL-.+_F|IOO-MC_L)$} $chan] || \
	    [regexp {^.0:PEM-.+_(TILT|SEIS).$} $chan] || \
	    [regexp {^..:SUS-.+_SENSOR} $chan] || \
	    [regexp {^..:SEI-ETM._FINE.$} $chan] } {
	return 512
    }

    #-- If we get here, then this should be a 16 Hz floating-point channel
    return 64
}


##=========================================================================
## Name: ListDataTypes
##

proc ListDataTypes { tl } {

    set tlbase [string range $tl 1 end]

    ;##- Get access to the frame cache information
    if { ! [info exists ::cache$tlbase] } { return }

    ;##- Construct a list of the different available data types
    set keylist [lsort [array names ::cache$tlbase *,raw ] ]
    catch { unset types }
    foreach key $keylist {
	regexp {,([^,]*),} $key match type
	set types($type) 1
    }
    set typelist [lsort -dictionary [array names types]]

    ;##- Create a listbox window
    set lbw [DisplayListbox "Data types" "Data types" $typelist]

    ;##- Link this listbox to the entry

    bind $lbw.list.lb <ButtonRelease-1> \
	    "$tl.type.entry delete 0 end;\
	    $tl.type.entry insert end\
	    \[$lbw.list.lb get \[$lbw.list.lb curselection\]\];\
	    $tl.queryhead.refresh invoke"

    message $lbw.click -justify center -aspect 10000 -text "Click to select"
    pack $lbw.click -before $lbw.list -side bottom

    bind $tl <Destroy> \
	    "+ if {\"%W\"==\"$tl\" && \[winfo exists $lbw\]}\
	    {if \[winfo exists ${lbw}Icon\] {destroy ${lbw}Icon};\
	    wm deiconify $lbw; destroy $lbw}"

    return
}


##=========================================================================
## Name: Db2Submit
##
## Description:
##   Driver routine to submit a database query and do something with
##   the results once they are available.
## 
## Parameters:
##   query -- SQL query to be executed
##   displaytype -- what to do with the results (e.g. type of display)
##   ?-description description? -- optional description of the database
##         query (will appear in place of the actual SQL query)
##   ?-lblinks {...}? -- listbox-entry links (Tk widget pathnames)
##
## Usage:
##   Db2Submit query displaytype ?-description description? ?-lblinks {...}?
##
## Comments:
##   Just a simple routine to construct the full LDAS user command
##   and pass it on to the ManagerSubmit routine.

proc Db2Submit { query displaytype args } {

    if { $query == "" } { return }

    ;##- Modify the query if necessary
    set query [string trimleft $query]
    if { ! [regexp -nocase {for read only\s*$} $query] } {
	append query " FOR READ ONLY"
    }

    ;##- Build the DB info string, and the "-database" flag if necessary
    if { $::dbname == "Other" } {
	set dbinfo "${::otherdbhost}:${::otherdbport}, "
    } else {
	set dbinfo "$::dbname, "
    }
    append dbinfo "$::dbinst"
    if { [string is space $::dbinst] || $::dbinst == "default" } {
	set instance ""
    } else {
	set instance "-database $::dbinst"
    }

    ;##- If a description has been supplied, append the DB info.  If not,
    ;##- set the description to record the DB info.
    set index [lsearch -glob $args -desc*]
    if { $index >= 0 } {
	incr index
	set value [lindex $args $index]
	append value "\n($dbinfo)"
	set args [lreplace $args $index $index $value]
    } else {
	lappend args -description "dbinfo:$dbinfo"
    }

    set deffile [format "guildquery%03d" [expr {$::guildJobCounter+1}]]
    set cmd [selsub {getMetaData -returnprotocol http://$deffile\
	    -outputformat $::dbreturnformat $instance\
	    -sqlquery {$query}} \
	    deffile ::dbreturnformat query instance]

    eval [list ManagerSubmit $cmd $displaytype] $args

    return
}


##=========================================================================
## Name: ManagerSubmit
##
## Description:
##   Driver routine to submit manager query and do something with
##   the results once they are available
## 
## Parameters:
##   query -- manager query to be executed
##   displaytype -- what to do with the results (e.g. type of display)
##   ?-description description? -- optional description of the database
##         query (will appear in place of the actual SQL query)
##   ?-lblinks {...}? -- listbox-entry links (Tk widget pathnames)
##   ?-dbname dbname? -- if specified and not equal to "default",
##                           overrides the ::dbname global variable
##
## Usage:
##   ManagerSubmit query displaytype \
##           ?-description description? ?-lblinks {...}?
##
## Comments:
##   Submits a query, calls JobAdd to create a window to display the status
##   of the job, and then returns while the job is still running.
##   If an error occurs, returns the text of the error message, but does NOT
##   return with "-code error"

proc ManagerSubmit { query displaytype args } {
###    puts "In ManagerSubmit\n  query is $query\n \
###	    displaytype is $displaytype\n  args are $args"

    if { $query == "" } { return }

    ;##- Set defaults
    set description ""
    set lblinks {}
    set dbname $::dbname
    set email ""
    set mode "foreground"

    ;##- Get options
    foreach { opt optval } $args {
	switch -glob -- $opt {
	    -desc* { set description $optval }
	    -lblinks { set lblinks $optval }
	    -dbname { if { $optval != "default" } {set dbname $optval} }
	    -email { set email $optval }
	    -mode { set mode $optval }
	}
    }
    global dbuser dbpass dbemail globusUser
    ;## if globus  make sure we have a valid proxy
    if  { $::ACCESS_METHOD == "X509 proxy" } {
        if 	{ [ catch {
            verifyProxyWithRetry
	    debugPuts "returned from verifyProxyWithRetry"
       	} err ] } {
	    debugPuts "ERROR from verifyProxyWithRetry"
	    return $err
        }
    } 
    debugPuts "returned from verifyProxyWithRetry, with ACCESS_METHOD==$::ACCESS_METHOD"
     
    if  { $::ACCESS_METHOD != "X509 proxy" } {        
        ;##- Get the information required to connect to the database, if necessary
        if { [info exists dbuser] == 0 } { GetDbUser }
        ;##- If username still is unset, just return
        if { [info exists dbuser] == 0 } {
	        return "LDAS username/password have not been set"
        }
    }

    set server "$dbname LDAS manager"
    if { $dbname == "Other" } {
	set addr $::otherdbhost
	set port $::otherdbport
	set globus_port $::otherdbglobusport 
    } else {
	set addr $::manager_ip($dbname)
	set port $::manager_op($dbname)
	set globus_port $::manager_globus_op($dbname)
    }

    ;##- Assign an internal job id number
    incr ::guildJobCounter
    set guildJobId $::guildJobCounter

    ;##- Add this job to list of active jobs (unless we don't want a window)
    if { $displaytype != "no_window" } {
	JobAdd $guildJobId $query $server $addr $displaytype $description \
		$lblinks $email $mode
    } else {
	set ::jobInfo($guildJobId) ""
    }

    ;##- Make sure a valid manager host/port is specified
    if { [string is space $addr] || ! [regexp {^\d{1,5}$} $port] } {
	JobUpdate $guildJobId error \
		"Invalid address ($addr) and/or port ($port) for LDAS manager"
	return "Invalid address ($addr) and/or port ($port) for LDAS manager"
    }

    set servername "$dbname LDAS manager ($addr, port $port)"

    #-- Set a local variable to indicate whether to use a persistent socket
    #-- connection for this job.  It may or may not have the same value as
    #-- the global variable '::usepersistent'.

    set usepersistent $::usepersistent

    ;##- Make a local copy of the global ::useproxy.  Below, we may modify the
    ;##- local copy only (if we need to use the proxy server for this job, but
    ;##- not for all possible jobs) or both the local and global copies (if we
    ;##- must use the proxy server for every job).

    set useproxy $::useproxy

    ;##- If we can't (or don't want to) use a persistent connection, and
    ;##- don't currently think that we need to use the proxy server, then
    ;##- we connect directly to the LDAS manager so that we can determine our
    ;##- IP address.  But it may turn out that our IP address is a "private"
    ;##- one which is being mapped to something else by a router, or is known
    ;##- to be behind a firewall.  In this case, we will have to fall back to
    ;##- using the proxy server.  So the code in the "while" loop below may
    ;##- have to be executed twice.

    set connected 0

    while { 1 } {

	#---- If our IP address is known, and the nominal setting is to NOT
	#---- use the proxy server, then decide whether to use it in this case

	if { $::guildListenIP != "" && $usepersistent == "no" \
		 && $useproxy == "no" } {

	    ;##- Check whether our IP address is one of the ones reserved for
	    ;##- "private" networks.  If so, we will always need to use the
	    ;##- LDAS job proxy server since some router is mapping our
	    ;##- IP address to something else.
	    if { [regexp {^10\.} $::guildListenIP] || \
		    [regexp {^172\.(1[6-9]|2[0-9]|3[01])\.} $::guildListenIP] \
		    || [regexp {^192\.168\.} $::guildListenIP] \
		    || [regexp {^169\.254\.} $::guildListenIP] } {
		set useproxy "yes"
		#-- Also update the global variable, for future jobs
		set ::useproxy "yes"
	    }

	    ;##- Check whether our IP address is at LLO and we're connecting to
	    ;##- some LDAS system which is NOT at LLO, in which case we have to
	    ;##- work around the LLO firewall.
	    if { $useproxy == "no" && \
		     ( [regexp {^130\.39\.245\.} $::guildListenIP ] \
			   && [regexp {\.} $addr ] \
			   && ! [regexp {^130\.39\.245\.} $addr ] \
			   && ! [regexp -nocase {\.ligo-la} $addr ] ) } {
		set useproxy "yes"
	    }

	}


	#---- If we're currently connected, then this must be the second time
	#---- through the 'while' loop.  The first time through, we connected
	#---- directly to LDAS.  Now decide what to do based on whether we've
	#---- determined that we need to use the proxy server.

	if { $connected } {
	    if { $useproxy == "no" } {
		#-- Our current connection (directly to LDAS) is what we want
		break
	    } else {
		#-- We need to disconnect, and reconnect to the proxy server
		close $sid
		set connected 0
		#-- Continue on to code below...
	    }
	}


	#---- If we are supposed to use the proxy, update the address to
	#---- point to it.  Use the LJPROXY environment variable if it exists
	#---- (valid forms:  <host>  or  <host>:<port> )

	if { $usepersistent == "no" && $useproxy == "yes" } {
	    set connectline "connect $addr $port"
	    set port 9802
	    if { [info exists ::env(LJPROXY)] \
		    && $::env(LJPROXY) != "default" } {
		if { ! [regexp {^([^:]+):(\d+)$} $::env(LJPROXY) \
			match addr port] } {
		    set addr $::env(LJPROXY)
		}
	    } else {
		set addr "mirfak.ligo.caltech.edu"
	    }
	    set servername "LDAS job proxy server on $addr . \
		    Please contact Peter Shawhan (shawhan_p@ligo.caltech.edu)."
	}


	#---- Open a socket to the manager (or proxy).  Do an asynchronous open
	#---- so that we can implement our own timeout mechanism.

	set ::mgrSock$guildJobId pending
	set evtid [after $::MANAGER_REPLY_TIMEOUT "set ::mgrSock$guildJobId timeout"]

	debugPuts "using access method $::ACCESS_METHOD"
	if { $::ACCESS_METHOD == "X509 proxy" } {
            if 	{ [ catch {
        	set port $globus_port
		debugPuts "Opening gsi connection to $addr, port $port"
		set gsicmd "gt_xio_socket"
		if { [ info exist ::PROXY_TYPE ] && [ string length $::PROXY_TYPE ] } {
		    append gsicmd " $::PROXY_TYPE "
		}
            
		if { $::USE_GSI } {
		    append gsicmd " $::GSI_AUTH_ENABLED "
		}

		append gsicmd " $addr $port "
		debugPuts "globus socket command $gsicmd"
		set sid [ eval $gsicmd ]
		debugPuts "opened gsi socket $sid"
          	fconfigure $sid -buffering full -blocking 0
    	 	fconfigure $sid -translation binary -encoding binary
		debugPuts "set up fileevent w for socket $sid"
		fileevent $sid w "set  ::mgrSock$guildJobId writable"
	    } err ] } {
       		set msg "Error connecting to LDAS manager $addr $port : $err"
		debugPuts $msg
    		return "Error while connecting to $servername $err"
	    }
	} else {
	    if { [catch {socket -async $addr $port} sid] } {
	    	JobUpdate $guildJobId error \
		    "Error while connecting to $servername\n$sid"
	    	after cancel $evtid
	    	unset ::mgrSock$guildJobId
	    	return "Error while connecting to $servername\n$sid"
	    }
	    fileevent $sid w "set ::mgrSock$guildJobId writable"
	    debugPuts "using username/password $sid to $addr $port" 
	}
	vwait ::mgrSock$guildJobId

	fileevent $sid w {}
	after cancel $evtid
	if { [set ::mgrSock$guildJobId] == "timeout" } {
	    JobUpdate $guildJobId error \
		    "Timeout while connecting to $servername"
	    catch { close $sid }
	    unset ::mgrSock$guildJobId
	    return "Timeout while connecting to $servername"
	}

	unset ::mgrSock$guildJobId
	;##- MacOS doesn't seem to support the '-error' option to fconfigure,
	;##- so we have to work around this.
	if { [catch {fconfigure $sid -error} msg] } {
	    set msg ""
	}
	if { ! [string is space $msg] } {
	    if { $msg == "connection refused" } {
		JobUpdate $guildJobId error "No response from $servername"
	    } else {
		JobUpdate $guildJobId error \
			"Error while connecting to $servername\n$msg\n"
	    }
	    catch { close $sid }
	    return "No response from $servername"
	}

	;##- If we get to this point, then the socket connection succeeded
	if { [catch {fconfigure $sid -peername} peerinfo] } {
	    JobUpdate $guildJobId error \
		    "Cannot determine IP address of LDAS manager using\
		    'fconfigure $sid -peername'\n$peerinfo\n"
	    return "Error determining IP address of LDAS manager"
	}
	set peerIP [lindex $peerinfo 0]
	set connected 1

	;##- If we didn't know our IP address before making this connection,
	;##- then record it now.
	if { $::guildListenIP == "" } {
	    ;##- Figure out our IP address 
	    	catch { set portinfo [fconfigure $sid -sockname] } err 
###	    	puts "client portinfo is $portinfo, tclglobus does not support -sockname"
		    if	{ ![ info exist portinfo ] } {
        		set portinfo local
        	}
        	debugPuts "portinfo $portinfo err $err"
	    	set ::guildListenIP [lindex $portinfo 0]

	    ;##- If we initially connected directly to LDAS, then we need to go
	    ;##- back to check whether we really have to use the proxy server.
	    if { $usepersistent == "no" && $useproxy == "no" } {
		continue
	    }
	}

	#-- If we get here, then we know we've connected to the right place
	break

    }    ;##- End of "while { 1 } {}"


    ;##- If necessary, open a listening socket
    if { $::guildListenPort==0 && $usepersistent=="no" && $useproxy=="no"  } {

	if { [catch {socket -server JobMsgConnect -myaddr $::guildListenIP 0} \
		lsock] } {
	    JobUpdate $guildJobId error \
		    "Unable to open a listening socket:\n$lsock"
	    return "Unable to open a listening socket:\n$lsock"
	}
	set portinfo [fconfigure $lsock -sockname]
###	puts "listening portinfo is $portinfo"
	set ::guildListenPort [lindex $portinfo 2]
###	puts "Opened a listening socket on port $::guildListenPort"

    }

    ;##- Set the "email address" (actually host and port) for job info messages
    if { $usepersistent == "yes" } {
	set dbemail "persistent_socket"
    } elseif { [string is space $email] } {
	set dbemail "!host!:$::guildListenPort"
    } else {
	set dbemail $email
    }

    ;##- Construct the ldas command using $query
    ;## -name <user> and -password <password> are meaningless for globus sockets
    ;## but keep the same format for the job string
    
    if  { $::ACCESS_METHOD != "X509 proxy" } {
        set ldascmd [selsub {ldasJob \
	    {-name $dbuser -password md5protocol -email $dbemail} \
	    {$query}} \
	    dbuser dbemail query ]
        set ::md5pw [md5::md5 $dbpass]
    } else {
        set ldascmd [selsub {ldasJob \
	    {-name $globusUser -password X509 -email $dbemail} \
	    {$query}} \
	    globusUser dbemail query ]
    }
    
    debugPuts "ldascmd is $ldascmd"

    if { $usepersistent == "no" && $useproxy == "yes" } {
	        puts $sid $connectline
        }

    ;##- Send the command to the manager
    if {[catch {
    	puts $sid $ldascmd
    } msg ] } {
		JobUpdate $guildJobId error \
		"Error sending command to LDAS manager:\n$msg"
		return "Error sending command to LDAS manager:\n$msg"
    }
    ;##- Update the job status
    JobUpdate $guildJobId submitted $peerIP

    ;##- Get the job info
    if {[catch {flush $sid} msg]} {
	JobUpdate $guildJobId error \
		"Error sending command to LDAS manager\
		(flushing output):\n$msg"
	return "Error sending command to LDAS manager (flushing output):\n$msg"
    }

    fconfigure $sid -blocking 0
    if { $displaytype != "no_window" } {
	;##- Set up a fileevent callback routine to handle data on this socket
	fileevent $sid readable [list JobInfoHandle $sid $guildJobId]
    } else {
	;##- Set up a fileevent, but ignore all the data!
	fileevent $sid readable [list JobInfoHandle $sid $guildJobId ignore]
    }
    return ""
}


##=========================================================================
## Name: JobInfoHandle
##
## Description:
##   Callback routine to handle job information returned by managerAPI.
## 
## Parameters:
##   sock -- socket ID
##   guildJobId -- internal job identifier
##   ?ignore? -- if present and non-blank, all info is ignored
##
## Usage:
##   fileevent $sock readable [list JobInfoHandle $sock $guildJobId]
##
## Comments:
##   This prevents guild from blocking if the manager is throttling.

proc JobInfoHandle { sock guildJobId {ignore ""} } {

    upvar #0 jobInfo($guildJobId) jobinfo
    
	if  { [ info exist jobinfo ] } {
        debugPuts "jobinfo $jobinfo"
    }
    
    if { [eof $sock] } {

	if { [string is space $ignore] } {
	    ;##- Parse the job info to try to determine the job ID
	    ;##- (or result text, in case we used the LDAS job proxy)
	    set jobid ""
	    if { [regexp {\+\+\+\+\+\+ RESULT \S+?\n(.+?)\n\+\+\+\+\+\+} \
		    $jobinfo match resultinfo] } {
		#-- This is a job-done message on a proxied connection
		set ::jobMessage($guildJobId) $resultinfo
		after 0 "UseJobResults $guildJobId"
	    } elseif { [regexp {^\s*Subject:} $jobinfo] } {
		#-- This is a job-done message on a persistent connection
		set ::jobMessage($guildJobId) $jobinfo
		after 0 "UseJobResults $guildJobId"
	    } elseif { [regexp {Your job is running as: *"([^\"\n]*)"} \
		    $jobinfo match jobid]} {
		#-- This is a job-info message on a transient connection
###		puts "Job ID is $jobid";
		JobUpdate $guildJobId running $jobid
	    } elseif { ! [string is space $jobinfo] } {
		#-- Some error must have occurred
		JobUpdate $guildJobId error \
			"The job was not accepted by the LDAS\
			manager.\nMessage returned by manager:\n$jobinfo"
	    }
	} else {
	    unset ::jobInfo($guildJobId)
	}

	;##- Remove the handler for this socket
	fileevent $sock readable {}
	catch {close $sock}

    } else {

	append jobinfo [read $sock]

	;##- Check whether LDAS has sent us an MD5 "salt" to use
	if { [regexp {^md5salt ([^\}\s]+)} $jobinfo match md5salt] } {
	    ;##- Append the "salt" (specified by LDAS) to the MD5 hash of the
	    ;##- actual password, calculate the MD5 digest, and send it back
	    ;##- to LDAS
	    set md5data "$::md5pw$md5salt"
	    set md5digest [md5::md5 $md5data]
	    puts $sock [list "md5digest" $md5digest]
	    flush $sock
	    ;##- Delete this section of the job info, since we've used it
	    regsub {^md5salt ([^\}\s]+)\s*} $jobinfo {} jobinfo
	}

	if { [regexp {\+\+\+\+\+\+ INFO\n(.+?)\n\+\+\+\+\+\+} $jobinfo \
		match infomsg] } {
	    #-- This is a job-info message on a proxied connection
	    set jobid ""
	    if { [regexp {Your job is running as: *"([^\"\n]*)"} \
		    $infomsg match jobid]} {
###		puts "Job ID is $jobid";
		JobUpdate $guildJobId running $jobid
	    } else {
		JobUpdate $guildJobId error \
			"The job was not accepted by the LDAS\
                        manager.\nMessage returned by manager:\n$infomsg"
	    }

	    ;##- Delete this section, since we've already used it
	    regsub {\+\+\+\+\+\+ INFO\n(.+?)\n\+\+\+\+\+\+} $jobinfo {} jobinfo

	} elseif { [regexp \
		  {\{.*Your job is running as: *"([^\"\n]*)"[^\}]*\}\s*(.*)$} \
			$jobinfo match jobid remainder] } {
	    #-- This is a job-info message on a persistent connection
	    JobUpdate $guildJobId running $jobid
            #-- Delete the part of the job info that was matched
	    set jobinfo $remainder
   	} elseif { [regexp {\{mgr::userInfo: ([^\}]+)\}} $jobinfo match msg] } {
	    #-- This is an error message on a persisitent connection
	    JobUpdate $guildJobId error $msg
	    fileevent $sock readable {}
	    catch {close $sock}
	}

	#-- Trim any leading spaces off of jobinfo
	set jobinfo [string trimleft $jobinfo]

    }

    return
}


##=========================================================================
## Name: JobAdd
##
## Description:
##   Adds a job to the list of active jobs.
## 
## Parameters:
##   guildJobId -- internal job identifier
##   query -- Query to be executed
##   server -- Name of server handling this job (e.g. LDAS database site)
##   addr -- Internet hostname of LDAS manager to which job was sent
##   displaytype -- what to do with the results (e.g. type of display)
##   description -- optional description of the query (else blank)
##   lblinks -- listbox-entry links (Tk widget pathnames)
##   email -- email addres
##   mode -- "foreground" or "background"
##
## Usage:
##   JobAdd guildJobId query server addr displaytype description lblinks \
##           email mode
##
## Comments:
##   Generic routine for any server (not just LDAS database).
##   displaytype can be one of the following:
##     * scrolledtable -- full scrollable table display, suitable for
##                         displaying multiple database entries
##     * namevalue -- a two-column list of name/value pairs for a single
##                      database entry
##     * listbox -- a scrollable list of values, suitable for a query which
##                      returns a single column of values
##     * rowcount -- just pops up a message window with the
##                      number of rows which match the query
##     * file -- write output to a local file
##     * {TCL word word ...} -- a list containing the word TCL followed by
##                      an arbitrary Tcl command.  The special symbol
##                      _OUTPUT_ will be replaced by the output of the job.
##                      NOTE that if the job fails (i.e. there is no output),
##                      then NONE of this command will be executed.
## ;#ol

proc JobAdd { guildJobId query server addr displaytype description lblinks \
	email {mode "foreground"} } {
###    puts "Doing JobAdd $guildJobId ..."

    if { $mode == "foreground" } {
	;##- Create a new window to display the job status
	set tl [NewToplevel]

	wm title $tl "Job pending"

	$tl config -highlightthickness 4 -highlightcolor $::bgColor

	if {$::winIcons} {
	    ;##- Also create an icon for this window
	    NewToplevel ${tl}Icon -icon -width 48 -height 48 \
		    -highlightthickness 0
	    ${tl}Icon config -highlightthickness 4 \
		    -highlightcolor yellow -highlightbackground yellow
	    label ${tl}Icon.bitmap -image jobIcon
	    pack ${tl}Icon.bitmap -side top -fill x
	    wm iconwindow $tl ${tl}Icon
	    wm iconname $tl "Pending"
	}
    } else {
	set tl ""
    }

    ;##-------------------------------
    ;##- Add the job parameters to the global arrays
    lappend ::guildJobsActive $guildJobId
    set ::jobInfo($guildJobId) ""
    set ::jobStatus($guildJobId) "init"
    set ::jobAbort($guildJobId) 0
    set ::jobToplevel($guildJobId) $tl
    set ::jobDisplaytype($guildJobId) $displaytype
    set ::jobDescription($guildJobId) $description
    set ::jobServer($guildJobId) $server
    set ::jobServerIP($guildJobId) ""
    set ::jobServerId($guildJobId) ""
    set ::jobMessage($guildJobId) ""
    set ::jobLblinks($guildJobId) $lblinks
    set ::jobEmail($guildJobId) $email
    set ::jobStartTime($guildJobId) [clock clicks -milliseconds]

    ;##- Update the status display in the main guild window
    UpdateStatus

    ;##- If running in background mode, just return
    if { $mode != "foreground" } { return }

    ;##-------------------------------
    ;##- Put widgets in the job status window

    label $tl.queryhead -text "User command:"

    frame $tl.query
    if { [string is space $description] || [regexp {^dbinfo:} $description] } {
	scrollbar $tl.query.yscroll -orient vertical \
		-command "$tl.query.text yview"
	if {[string length $query] < 120} {set width 40} else {set width 72}
	text $tl.query.text -width $width -height 4 -wrap word -setgrid false \
		-yscrollcommand "$tl.query.yscroll set"
        bind $tl.query.text <Button> "focus %W"
	$tl.query.text insert end $query
	$tl.query.text configure -state disabled
	grid $tl.query.text $tl.query.yscroll -sticky news
    } else {
	label $tl.query.label -text "\[[string map {\n { }} $description]\]" \
		-justify left -relief sunken -anchor w
	grid $tl.query.label -sticky news
    }
    grid rowconfigure $tl.query 0 -weight 1
    grid columnconfigure $tl.query 0 -weight 1

    label $tl.submitted -text "Submitting to $server"
    label $tl.jobstate -text "Job pending..."
    label $tl.elapsed -text "Elapsed time: 0:00"

    menubutton $tl.abort -text "Abort" \
	    -font normhelv -padx 0 -pady 0 -relief raised -direction above \
	    -menu $tl.abort.menu
    set m [menu $tl.abort.menu -tearoff 0]
    $m add cascade -label "Really abort this job?" -menu $m.sub1
    set m2 [menu $m.sub1 -tearoff 0]
    $m2 add command -label "Yes" \
	    -command "$tl.abort config -text {Aborting...} \
	    -state disabled -disabledforeground red;\
	    JobAbort $tl"

    button $tl.close -text "Close" -command "JobRemove $guildJobId destroy $tl"

    pack $tl.queryhead -side top -anchor w
    pack $tl.query -side top -fill both -expand true
    pack $tl.submitted -side top -anchor w
    pack $tl.jobstate -side top -anchor w
    pack $tl.elapsed -side top -anchor w
    pack $tl.close -side bottom
    ;##- Omit the Abort button until such time as it can be safely used
##    place $tl.abort -in $tl -relx 0 -rely 1 -anchor sw

    ;##- Finally, set up a button to raise the main guild window
    button $tl.raise -text "main" -font normhelv -padx 0 -pady 0 \
	    -command "switch -- \[wm state .\] \
	    normal {raise .} iconic {wm deiconify .}; focus ."
    place $tl.raise -in $tl -relx 1 -rely 1 -anchor se

    ;##---- Start the elapsed-time update loop
    StartElapsedLoop

    update idletasks

    return
}


##=========================================================================
## Name: JobUpdate
##
## Description:
##   Updates the status of a running job
## 
## Parameters:
##   guildJobId -- internal job identifier (can also be a toplevel Tk pathname)
##   status -- new status
##   jobid -- Job ID assigned by the server (if status is "started")
##   message -- Error message (if status is "error" or "finished")
##
## Usage:
##   JobUpdate guildJobId status ?jobid? ?message?
##
## Comments:
##   Called at various times when sockets are opened, etc.

proc JobUpdate { guildJobId status {arg ""} } {
###    puts "Doing JobUpdate $guildJobId $status"

    ;##- If $guildJobId is actually a Tk pathname, look up the true job id
    if { [regexp {^\.} $guildJobId] } {
	foreach gid $::guildJobsActive {
	    if { [string equal $guildJobId $::jobToplevel($gid)] } {
		set guildJobId $gid
		break
	    }
	}
	;##- Check once more that lookup was successful
	if { ! [regexp {^\d+$} $guildJobId] } {
	    return
	}
    }

    ;##- If this job no longer exists, just return
    if { ! [info exists ::jobStatus($guildJobId)] } { return }

    ;##- Update the job status
    set ::jobStatus($guildJobId) $status
    set tl $::jobToplevel($guildJobId)

    ;##- Handle various cases depending on the new status
    switch -- $status {

	submitted {
	    if { $tl != "" } {
		$tl.submitted config \
			-text "Submitted to $::jobServer($guildJobId)"
	    }
	    ;##- Record the numerical IP address of the LDAS manager
	    set peerIP $arg
	    set ::jobServerIP($guildJobId) $peerIP
	}

	running {
	    set jobid $arg
	    set peerIP $::jobServerIP($guildJobId)
	    set ::jobServerId($guildJobId) $jobid
	    set ::ldasJobList($peerIP/$jobid) $guildJobId
	    if { $tl != "" } {
		wm title $tl "Job $jobid"
		wm iconname $tl "$jobid"
	    }
	    if { $::jobEmail($guildJobId) == "" } {
		if { $tl != "" } {
		    $tl.jobstate config -text "Job $jobid is running" \
			    -bg yellow
		}

		;##- Check whether the job has already finished!
		if [info exists ::oddJobBuf($peerIP/$jobid)] {
		    set ::jobMessage($guildJobId) $::oddJobBuf($peerIP/$jobid)
		    unset ::oddJobBuf($peerIP/$jobid)
		    after 0 "UseJobResults $guildJobId"
		}

	    } else {
		if { $tl != "" } {
		    $tl.jobstate config \
			    -text "Job $jobid is running in the background"
		    destroy $tl.elapsed $tl.abort

		    label $tl.info -text \
			    "Messages will be sent to $::jobEmail($guildJobId)"
		    pack $tl.info -side top

		    if {$::winIcons} {
			;##- Put a gray border around the job icon
			${tl}Icon config -highlightcolor $::bgColor \
				-highlightbackground $::bgColor
			update idletasks
		    }
		}

		;##- Remove the job, as far as guild is concerned
		JobRemove $guildJobId
	    }

	    ;##- If job is marked to be aborted, do that now
	    if { [info exists ::jobAbort($guildJobId)] \
		    && $::jobAbort($guildJobId)} {
		after 0 "JobAbort $guildJobId"
	    }

	}

	parsing {
	    if { $tl == "" } { return }

	    set jobid $::jobServerId($guildJobId)
	    $tl.jobstate config -text "Job $jobid finished" -bg green

	    destroy $tl.abort $tl.elapsed

	    label $tl.parsestat -text "Parsing file..."
	    pack $tl.parsestat -side top -anchor w
	}

	finished {
	    if { $tl == "" } { return }

	    set message $arg

	    ;##- Destroy widgets, if they still exist
	    if { [winfo exists $tl.abort] } { destroy $tl.abort }
	    if { [winfo exists $tl.elapsed] } { destroy $tl.elapsed }
##	    $tl.close config -state normal

	    set jobid $::jobServerId($guildJobId)
	    $tl.jobstate config -text "Job $jobid finished" -bg green
	    destroy $tl.parsestat

	    ;##- If the message is blank for some reason, say so
	    if {[string is space $message]} {
		set message "(No result message available)"
	    }

	    ;##- Create a small text area to display the result of this job
	    text $tl.info -width 40 -height 3 -wrap word -setgrid false
	    bind $tl.info <Button> "focus %W"
	    $tl.info insert end [string trim $message]
	    $tl.info configure -state disabled
	    pack $tl.info -side top -fill both -expand true

	    ;##- Need to do this for the 'yview' below to be accurate
	    update idletasks

	    ;##- If the small text area isn't big enough to hold the whole
	    ;##- message, create a bigger text area with a scroll bar.
	    if { [lindex [$tl.info yview] 1] != 1 } {
		destroy $tl.info
		frame $tl.info
		scrollbar $tl.info.yscroll -orient vertical \
			-command "$tl.info.text yview"
		text $tl.info.text -width 72 -height 5 -setgrid false \
			-wrap word -yscrollcommand "$tl.info.yscroll set"
		bind $tl.info.text <Button> "focus %W"
		$tl.info.text insert end [string trim $message]
		$tl.info.text configure -state disabled
		grid $tl.info.text $tl.info.yscroll -sticky news
		grid rowconfigure $tl.info 0 -weight 1
		grid columnconfigure $tl.info 0 -weight 1
		pack $tl.info -side top -fill both -expand true
	    }

	    if {$::winIcons} {
		;##- Put a green border around the job icon
		${tl}Icon config \
			-highlightcolor green -highlightbackground green
		update idletasks

		;##- If icon is currently visible, do some extra things
		if {[winfo ismapped ${tl}Icon]} {

		    ;##- Set up a binding to recalculate the size of the 
		    ;##- window when it is deiconified, since size
		    ;##- recalculation seems to be skipped if the window
		    ;##- is currently iconified.
		    set width [winfo reqwidth $tl]
		    set height [winfo reqheight $tl]
		    bind ${tl}Icon <Unmap> \
			    "+ wm geometry $tl ${width}x${height};\
			    bind ${tl}Icon <Unmap> {}"

		    ;##- Ring the terminal bell
		    bell
		}
	    }

	}

	error {

	    ;##- If this job is already in the error state, just return
	    if { [lsearch -exact $::guildJobsError $guildJobId] >= 0 } return

	    ;##- Append this job to list of jobs in error state
	    lappend ::guildJobsError $guildJobId

	    if { $tl == "" } { return }
	    if [winfo exists $tl.errorhead] return

	    set message $arg
	    if { ! [string is space $message] } {
		append message "\n"
	    }

	    set jobid $::jobServerId($guildJobId)
	    if { [string is space $jobid] } {
		$tl.jobstate config -text "Job submission failed" \
			-fg red -bg $::bgColor
		wm title $tl "Job failed"
		wm iconname $tl "Failed job"
	    } else {
		$tl.jobstate config -text "Job $jobid ended with error" \
			-fg red -bg $::bgColor
	    }

	    label $tl.errorhead -text "Error message:"

	    frame $tl.error
	    scrollbar $tl.error.yscroll -orient vertical \
		    -command "$tl.error.text yview"
	    text $tl.error.text -width 72 -height 6 -wrap word -setgrid false \
		    -yscrollcommand "$tl.error.yscroll set"
	    bind $tl.error.text <Button> "focus %W"
	    $tl.error.text configure -state disabled
	    grid $tl.error.text $tl.error.yscroll -sticky news
	    grid rowconfigure $tl.error 0 -weight 1
	    grid columnconfigure $tl.error 0 -weight 1

	    destroy $tl.abort $tl.elapsed
	    pack $tl.errorhead -side top -anchor w
	    pack $tl.error -side top -fill both -expand true

	    if { ! [string is space $jobid] } {
		;##- Figure out which database this query went to
		set text [$tl.submitted cget -text]
		if { [regexp {^Submitted to (\S+) LDAS} $text match dbname] } {
		    if { [lsearch -exact $::dbservers $dbname] == -1 } {
			set dbname "default"
		    }
		} else {
		    set dbname "default"
		}

		;##- Create a "Get LDAS log entries" button
		button $tl.getlog -text "Get LDAS log entries" -command \
			"if {0} {destroy $tl.getlog};\
			ManagerSubmit \"getLogEntries\
			-returnprotocol http://oldlog -query $jobid\"\
			{TCL $tl.error.text config -state normal -height 15;\
			$tl.errorhead config -text \"LDAS log entries:\";\
			html::callback $tl.error.text _OUTPUT_;\
			$tl.error.text config -state disabled} -dbname $dbname"

		pack $tl.getlog -side top
	    }

	    ;##- Put a thick red border around the window
	    $tl config -highlightcolor red -highlightbackground red

	    if {$::winIcons} {
		;##- Also put a red border around the icon
		${tl}Icon config -highlightcolor red -highlightbackground red
	    }

	    update idletasks

	    ;##- Ring the terminal bell
	    bell

	    ;##- If the error message is still blank for some reason,
	    ;##- set it to something
	    if {[string is space $message]} {
		set message "(No error message available)\n"
	    }

	    ;##- Append the URL for LDAS problem reports
	    if { ! [regexp {\n\s*$} $message] } {
		append message "\n\n"
	    } elseif { ! [regexp {\n\s*\n\s*$} $message] } {
		append message "\n"
	    }
	    append message "If you think this is a problem with LDAS, you\
		    may submit a problem report at\
		    http://ldas-sw.ligo.caltech.edu/ProblemTracking.html"

	    ;##- Now put the error message into the text widget
	    $tl.error.text config -state normal
	    set charwidth [font measure [$tl.error.text cget -font] X]
	    $tl.error.text tag configure inwrap \
		    -lmargin2 [expr {0*$charwidth}]
	    $tl.error.text insert end $message inwrap
	    $tl.error.text config -state disabled
	}

    }

    ;##- Update the status area in the main window
    UpdateStatus

    return
}


##=========================================================================
## Name: JobAbort
##
## Description:
##   Aborts a running LDAS job.  If the LDAS job ID is not yet known,
##   the actual aborting is deferred until it is known.
## 
## Parameter:
##   guildJobId -- internal job identifier
##
## Usage:
##   JobAbort guildJobId
##
## Comments:


proc JobAbort { guildJobId } {

    ;##- If $guildJobId is actually a Tk pathname, look up the true job id
    if { [regexp {^\.} $guildJobId] } {
	foreach gid $::guildJobsActive {
	    if { [string equal $guildJobId $::jobToplevel($gid)] } {
		set guildJobId $gid
		break
	    }
	}
	;##- Check once more that lookup was successful
	if { ! [regexp {^\d+$} $guildJobId] } {
	    return
	}
    }

    ;##- If this job no longer exists, just return
    if { ! [info exists ::jobStatus($guildJobId)] } { return }

    ;##- Check whether we know the LDAS job ID
    if { $::jobServerId($guildJobId) == "" } {
	;##- Defer the abort until we know the LDAS job ID
	set ::jobAbort($guildJobId) 1
	return
    }

    ;##- Figure out which database this query went to
    set tl $::jobToplevel($guildJobId)
    set text [$tl.submitted cget -text]
    if { [regexp {^Submitted to (\S+) LDAS} $text match dbname] } {
	if { [lsearch -exact $::dbservers $dbname] == -1 } {
	    set dbname "default"
	}
    } else {
	set dbname "default"
    }

    ;##- Send a user command to abort the job
    ManagerSubmit "abortJob -stopjob $::jobServerId($guildJobId)" no_window \
	    -dbname $dbname

    return
}


##=========================================================================
## Name: JobRemove
##
## Description:
##   Removes internal job info about a job which has finished, or
##   (with an extra parameter) cancels a job which either is running
##   or is in an error state.
## 
## Parameters:
##   guildJobId -- internal job identifier
##   destroy -- if equal to "destroy", destroys the toplevel window
##   tl -- Can be used to specify which toplevel to destroy
##
## Usage:
##   JobRemove guildJobId ?destroy? ?tl?
##
## Comments:
##   Be sure to specify "destroy" in appropriate situations.

proc JobRemove { guildJobId {destroy ""} {tl ""} } {
###    puts "Doing JobRemove $guildJobId $destroy $tl"

    ;##- Clear global array information
    set index [lsearch -exact $::guildJobsActive $guildJobId]
    if { $index > -1 } {
	set ::guildJobsActive [lreplace $::guildJobsActive $index $index]

	;##- Also remove this job from the error list, if it is there
	set index [lsearch -exact $::guildJobsError $guildJobId]
	if { $index > -1 } {
	    set ::guildJobsError [lreplace $::guildJobsError $index $index]
	}

	if { $::jobToplevel($guildJobId) != "" } {
	    set tl $::jobToplevel($guildJobId)
	}

	set jobid $::jobServerId($guildJobId)
	set peerIP $::jobServerIP($guildJobId)
	catch { unset ::ldasJobList($peerIP/$jobid) }

	unset ::jobInfo($guildJobId)
	unset ::jobStatus($guildJobId)
	unset ::jobAbort($guildJobId)
	unset ::jobToplevel($guildJobId)
	unset ::jobDisplaytype($guildJobId)
	unset ::jobDescription($guildJobId)
	unset ::jobServer($guildJobId)
	unset ::jobServerIP($guildJobId)
	unset ::jobServerId($guildJobId)
	unset ::jobMessage($guildJobId)
	unset ::jobLblinks($guildJobId)
	unset ::jobEmail($guildJobId)
	unset ::jobStartTime($guildJobId)
    }

    if { $destroy == "destroy" && $tl != "" } {
	if { [winfo exists ${tl}Icon] } { destroy ${tl}Icon }
	if { [winfo exists $tl] } { destroy $tl }
    }

    ;##- Update the status area in the main window
    UpdateStatus

    return
}


##=========================================================================
## Name: JobMsgConnect
##
## Description:
##   Proc associated with listening socket, to handle a socket connection
##   initiated by the managerAPI for the purpose of reporting information
##   about a job.
## 
## Parameters:
##   sock -- socket identifier set up
##   addr -- IP address of managerAPI
##   port -- Port number for connection
##
## Usage:
##   JobMsgConnect sock addr port
##
## Comments:
##   Sets up a callback to JobMsgHandle which is executed when data
##   comes across the socket.

proc JobMsgConnect { sock addr port } {
###    puts "JobMsgConnect: accepted $sock from $addr port $port"
    fconfigure $sock -buffering line
    fileevent $sock readable [list JobMsgHandle $sock]
    set ::replySockIP($sock) $addr
    set ::replySockBuf($sock) ""
    return
}


##=========================================================================
## Name: JobMsgHandle
##
## Description:
##   Routine to handle job messages sent by the managerAPI.
## 
## Parameters:
##   sock -- socket over which message arrived
##
## Usage:
##   JobMsgHandle sock
##
## Comments:
##   Keeps track of multiple jobs, whose messages might be intermingled.

proc JobMsgHandle { sock } {

    set jobdone 0

    if { [eof $sock] } {
###	puts "Reached EOF on $sock"
	;##- Remove the handler for this socket
	fileevent $sock readable {}
	catch {close $sock}
	set jobdone 1
    } elseif { [catch {gets $sock line}] } {
###	puts "Error reading line from $sock"
	;##- Remove the handler for this socket
	fileevent $sock readable {}
	catch {close $sock}
	set jobdone 1
    }

    ;##- If the job is done, display the results (if possible)
    if { $jobdone == 1 } {

	;##- Look up the IP address of the system which sent the message
	set peerIP $::replySockIP($sock)

	;##- Parse the message to determine the LDAS job ID
	if { [ regexp {\s*Subject:\s*(\S+)} $::replySockBuf($sock) \
		match jobid ] } {

	    ;##- Workaround for nonstandard error message
	    if { [regexp {^error!?$} $jobid] } {
		regexp {^\s*Subject:\s+error!?\s+(\S+)} $::replySockBuf($sock) \
			match jobid
	    }

	    if { [info exists ::ldasJobList($peerIP/$jobid)] } {
		set guildJobId $::ldasJobList($peerIP/$jobid)

		;##- Strip out html and save this as the job message
		regsub -all {<.*?>} $::replySockBuf($sock) {} \
			::jobMessage($guildJobId)

		;##- Set up call to use results of job
		after 0 "UseJobResults $guildJobId"

	    } else {
		;##- This LDAS job id is unknown to us.  Maybe we have not yet
		;##- gotten the "Your job is running as..." message about it!
		;##- Cache it for future use.
		regsub -all {<.*?>} $::replySockBuf($sock) {} \
			::oddJobBuf($peerIP/$jobid)
	    }
	} else {
	    ;##- This message doesn't seem to be about an LDAS job.  Ignore it.
	}

	unset ::replySockIP($sock)
	unset ::replySockBuf($sock)
	return

    }


    ;##- If we get to this point, then we successfully read a line
###    puts "On $sock, received $line"
    append ::replySockBuf($sock) "$line\n"

    return
}


##=========================================================================
## Name: UseJobResults
##
## Description:
##   Parse job-done message and use it to display results or whatever.
##
## Parameters:
##   guildJobId -- guild internal job ID
##

proc UseJobResults { guildJobId } {

    ;##- If job no longer exists, just return
    if { ! [info exists ::jobDisplaytype($guildJobId)] } { return }

    set state summary
    set summary ""
    set outfiles {}
    set outfilereport {}
    set failed 0

    set jobout $::jobMessage($guildJobId)

    ;##- Try to parse any outputs in the reply message from the LDAS manager
    ;##- (this may or may not find anything)
    foreach block [regexp -all -inline {Your results:\s+?\S.*?\n *\n} $jobout] {

	#-- Get the filenames and/or path
	if { [regexp {Your results:\s+(\S.+\S)\s+can be found at:\s+(\S+)} \
		$block match files path] } {
	} elseif { [regexp {Your results:\s+(\S.+\S)} $block match files] } {
	    set path ""
	} else {
	    set path ""
	    set files {}
	}

	;##- Convert ftp path to an http path if necessary
	regsub {^ftp://([^/]+)/(:?ldas_outgoing/(:?jobs/)?)?} $path \
		{http://\1/ldas_outgoing/jobs/} path

	;##- Workaround for PSU LDAS system, 15 March 2002:
	;##- If the URL path is ill-formed, adjust it
	if { [regexp {^http://([^/]+)/(.*)ldas_outgoing(.*)$} $path \
		match urlip urlpathhead rest] && \
		( [regexp {^10\.} $urlip] \
		|| [regexp {^172\.(1[6-9]|2[0-9]|3[01])\.} $urlip] \
		|| [regexp {^192\.168\.} $urlip] \
		|| [regexp {^169\.254\.} $urlip] ) } {
	    set actualip $::jobServerIP($guildJobId)
	    set path "http://$actualip/ldas_outgoing$rest"
	}

	;##- Workaround for the CIT LDAS system running LDAS 0.7.0, for which
	;##- the diskcache API sometimes uses the wrong IP address in the URL
	;##- it reports for the output location
	regsub {http://131\.215\.114\.10} $path {http://131.215.114.9} path

	foreach file $files {

	    ;##- If it's a complete ftp URL, convert it to an http URL
	    regsub {^ftp://([^/]+)/(:?ldas_outgoing/(:?jobs/)?)?} \
		    $file {http://\1/ldas_outgoing/jobs/} file

	    #-- If it's a relative filename, prepend the path
	    if { [regexp {^(http|ftp|file):} $file] \
		    || [file pathtype $file] == "absolute" } {
		lappend outfiles $file
	    } else {
		lappend outfiles $path/$file
	    }
	}

    }

    set errmessage ""
    set displaytype $::jobDisplaytype($guildJobId)

    ;##- Determine whether the job succeeded or failed
    if { [regexp -nocase {data inserted ok} $jobout] \
	    || [regexp -nocase {inserted \d+ rows} $jobout] } {
	;##- Success; force displaytype to "jobmessage" since no output files
	set displaytype "jobmessage"
    } elseif { [regexp {^\s*Subject:\s+[^\n]*error} $jobout] } {
	;##- Job failed
	set failed 1
    } else {
	;##- Can't tell whether this job succeeded...assume it did
	;##- If there are no outputs, just set displaytype to "jobmessage"
	;##- (unless it is a Tcl command)
	if { [llength $outfiles] == 0 && \
		[string range $displaytype 0 3] != "TCL " } {
	    set displaytype "jobmessage"
	}
    }

    ;##- First handle the case in which we are supposed to execute a
    ;##- Tcl command using the results
    if { [string range $displaytype 0 3] == "TCL " } {
	;##- If job was successful, do something with the output
	set cmd [string range $displaytype 4 end]

	;##- If there was output, retrieve it
	if { [llength $outfiles] > 0 } {

	    ;##- Retrieve the job output into memory
	    set url [lindex $outfiles 0]
	    set httpvar [GeturlWhole $url -timeout 0]
###	    puts "httpvar is $httpvar"
	    upvar #0 $httpvar httpstate

	    ;##- Parse the http response string
	    regexp -- {^(\S+)\s(\S+)\s(.*)$} $httpstate(http) \
		    match httpversion retcode httpstatus
	    if { $retcode != "200" } {
		JobUpdate $guildJobId error "Error retrieving job\
			output from $url (http code $retcode)"
		http::cleanup $httpvar
		return
	    }

	} elseif { [regexp "_OUTPUT_" $cmd] } {
	    JobUpdate $guildJobId error "Job failed"
	    return
	}

	;##- Replace _OUTPUT_ with the actual output
	regsub -all "_OUTPUT_" $cmd {$httpstate(body)} cmd

	;##- Replace _MESSAGE_ with the text of the job reply message
	regsub -all "_MESSAGE_" $cmd [list $jobout] cmd

	;##- Evaluate the command!
	foreach subcmd [split $cmd ";"] {
###	    puts "Evaluating $subcmd"
	    catch { eval $subcmd }
	}
	JobRemove $guildJobId destroy

	;##- Clean up
	if { [llength $outfiles] > 0 } {
	    http::cleanup $httpvar
	}

	return
    }

    ;##- If this is a known transient error, tack on a note
    if { [regexp {md5Challenge: expected: 'md5digest', received ''} \
	    $jobout] } {
	set jobout "NOTE: This is due to a known intermittent bug in LDAS. \
		Please resubmit.\n\n$jobout"
    }

    ;##- Handle the case where we just want to display the job status
    ;##- message, but not try to download the results
    if { $displaytype == "jobmessage" } {
	if { $failed } {
	    JobUpdate $guildJobId error $jobout
	} else {
	    JobUpdate $guildJobId finished $jobout
	}
	return
    }

    ;##- Make sure LDAS isn't telling us duplicated filenames
    set work [lsort $outfiles]
    set wlast ""
    foreach wfile $work {
	if { [string equal $wfile $wlast] } {
	    JobUpdate $guildJobId error "LDAS reports two or more result files\
		    with the same name: $wfile"
	    return
	}
	set wlast $wfile
    }

    ;##- If job was successful, go ahead and display the results
    if { [llength $outfiles] > 0 } {

	if { $::dbtempfile == "no" && $displaytype != "file" } {
	    ;##- Just keep track of the URL; other routines will retrieve.
	    ;##- NOTE this keeps track of only the first file, even if
	    ;##- multiple files were returned by the LDAS job.
	    set filename [lindex $outfiles 0]

	} elseif { $::dbtempfile == "yes" || $displaytype == "file" } {

	    set statwidget ""
	    if { $displaytype == "file" } {
		JobUpdate $guildJobId parsing
		if { [info exists ::jobToplevel($guildJobId)] } {
		    set tl $::jobToplevel($guildJobId)
		    if {[winfo exists $tl.parsestat]} {
			set statwidget $tl.parsestat
			catch { $statwidget config \
				    -text "Parsing list of result files..." }
			update idletasks
		    }
		}
	    }

	    ;##------ Retrieve the results into temporary file(s)
	    foreach url $outfiles {

		;##- If this is not an http url, generate an error message
		if { ! [regexp {^http:} $url] } {
		    set errmessage "Job output ($url) is not expressed as\
			    http URL.  You probably didn't specify a\
			    -returnprotocol of the form \"http:...\"."
		    break
		}

		;##- If job was canceled, bail out
		if { ! [info exists ::jobServerId($guildJobId)] } { return }

		;##- Open output file and pipe directly to it
		regexp {^\S+} $::jobServer($guildJobId) dbname

		;##- If this is a frame file, then replace "RDS_R_L1" with
		;##- "frame" to avoid confusion with official RDS frame files.
		;##- Otherwise, if the filename already includes the LDAS job
		;##- number, then use it as it is; otherwise, prepend the
		;##- server and job ID
		if { [regexp {\.gwf$} $url] } {
		    regsub {RDS_R_L1} [file tail $url] "frame" filename
		} else {
		    regexp {\d+} $::jobServerId($guildJobId) jobnum
		    if { [regexp "\[A-Za-z_%\]$jobnum\\D" $url] } {
			set filename [file tail $url]
			if { [regexp {^(daq|out)\.ilwd$} $filename] } {
			    set filename "$dbname${jobnum}_out.ilwd"
			}
		    } else {
			set filename "$dbname${jobnum}_[file tail $url]"
		    }
		}

		if { $displaytype != "file" } {
		    set filename "guildtemp.$filename"
		}

		if { [catch {open $filename w} fid] } {
		    set errmessage "Error occurred when guild tried\
			    to create file in current directory:\n$fid" 
		    break
		} else {

		    if { ! [string is space $statwidget] } {
			catch { $statwidget config \
				-text "Retrieving $filename ..." }
			update idletasks
		    }

		    fconfigure $fid -translation binary
		    set httpvar [GeturlWhole $url -channel $fid -timeout 0 \
				    -blocksize 131072]
###		    puts "httpvar is $httpvar"
		    upvar #0 $httpvar httpstate

		    ;##- Parse the http response string
		    regexp -- {^(\S+)\s(\S+)\s(.*)$} $httpstate(http) \
			    match httpversion retcode httpstatus

		    ;##- Handle errors
		    if { $retcode == 404 } {
			set errmessage "Job output is missing!\nWas\
				expected to be at:\n$url"
		    } elseif { $retcode != "200" } {
			set errmessage "Error retrieving job output\
				from $url !\nhttp return code $retcode"
		    }
###		    puts $httpstate(type)

		    catch {close $fid}
		    http::cleanup $httpvar
		    lappend outfilereport $filename
		}
	    }
	}

    } elseif { ! [string is space $jobout] } {
	set errmessage $jobout

	;##- Modify the message for improved readability
	set pat {^.*?Start of Error Messages File:.*?Line:[ \d]*}
	append pat {(SQLSTATE: .*)SQLSTATE=\d+}
	if { [regexp $pat $errmessage match core] } {
	    set errmessage $core
	}

    } else {
	set errmessage "No error message received from manager!"
    }

    ;##- If results were sucessfully downloaded, display them;
    ;##- otherwise modify the job status window to report error

    if { [string is space $errmessage] } {
###	puts "Now calling DisplayFile on $filename"

	;##- Look up information needed to display this file
	if { [info exists ::jobToplevel($guildJobId)] } {
	    set tl $::jobToplevel($guildJobId)
	    if { ! [winfo exists $tl] } { set tl "" }
	} else {
	    set tl ""
	}
	if { $displaytype != "file" } {
	    JobUpdate $guildJobId parsing

	    set description $::jobDescription($guildJobId)
	    if { [info exists ::jobLblinks($guildJobId)] } {
		set lblinks $::jobLblinks($guildJobId)
	    } else {
		set lblinks {}
	    }
		
	    ;##- Now display
	    set dispTl [DisplayFile $filename $displaytype \
		    -toplevel $tl -label $description]
		
	    ;##- Activate listbox-entry links, if specified
	    if { $dispTl != "" && [llength $lblinks] > 0 } {
		set widget [lindex $lblinks 0]
		if { [winfo exists $widget] } {
		    set buildtl [winfo toplevel $widget]
		    message $tl.click -justify center -aspect 10000 \
			    -text "Double-click to paste"
		    pack $tl.click -before $tl.list -side bottom
		    eval ListboxEntryLinks $tl.list.lb $lblinks
		    bind $buildtl <Destroy> \
			  "+ if {\"%W\"==\"$buildtl\" && \[winfo exists $tl\]}\
			  {if \[winfo exists ${tl}Icon\] {destroy ${tl}Icon};\
			  wm deiconify $tl; destroy $tl}"
		}
	    }

	} else {

	    if { [llength $outfilereport] == 0 } {
		set msg "No result files were retrieved!"
	    } elseif { [llength $outfilereport] == 1 } {
		set msg "Result file $outfilereport was created in [pwd]"
	    } else {

		;##- Figure out what is common to all filenames
		set firstfile [lindex $outfilereport 0]
		set begm $firstfile
		set endm $firstfile

		foreach file $outfilereport {
		    while { ! [string match "${begm}*" $file] } {
			set begm [string range $begm 0 end-1]
		    }
		    while { ! [string match "*${endm}" $file] } {
			set endm [string range $endm 1 end]
		    }
		}

		if { [string equal $begm $firstfile] } {
		    set metaname $firstfile
		} else {
		    set metaname "${begm}*${endm}"
		}

		set msg "[llength $outfilereport] result files $metaname\
			were created in [pwd]"
	    }
	    if { $tl != "" } {
		JobUpdate $guildJobId finished $msg
###		bell
	    } else {
		set ignore [ tk_messageBox -type ok -icon info \
			-title "Result file saved" -message $msg ]
	    }
	}

	;##- Remove internal information about this job
	JobRemove $guildJobId

    } else {
	JobUpdate $guildJobId error $errmessage
    }

    return
}


##=========================================================================
## Name: StartElapsedLoop
##
## Description:
##   Start the loop which updates the elapsed times in the job status windows.
## 
## Parameters:
##   none
##
## Usage:
##   StartElapsedLoop
##
## Comments:
##   Once the loop is started, it keeps itself going.

proc StartElapsedLoop {} {
###    puts "Starting ElapsedLoop"
    after cancel "ElapsedLoop"
    ElapsedLoop
    return
}


##=========================================================================
## Name: ElapsedLoop
##
## Description:
##   Update the elapsed-time counters in all existing job status windows.
## 
## Parameters:
##   none
##
## Usage:
##   ElapsedLoop
##
## Comments:
##   This routine re-schedules itself unless there are no active jobs.

proc ElapsedLoop {} {

    set curtime [clock clicks -milliseconds]

    set nrunning 0
    foreach guildJobId $::guildJobsActive {
	if { $::jobStatus($guildJobId) != "error" \
		&& $::jobStatus($guildJobId) != "finished" } {
	    set tl $::jobToplevel($guildJobId)
	    if { $tl == "" } { continue }

	    set starttime $::jobStartTime($guildJobId)
	    set deltime [expr {int(($curtime-$starttime)/1000)}]
	    if { ! [info exists ::lastdeltime$tl] } { set ::lastdeltime$tl 0 }
	    if { $deltime != [set ::lastdeltime$tl] } {
		set ::lastdeltime$tl $deltime
		set delmins [expr {int($deltime/60)}]
		set delsecs [expr {$deltime-60*$delmins}]
		set message [format "Elapsed time: %d:%02d" $delmins $delsecs]
		catch { $tl.elapsed config -text $message }

		;##- Pop up a warning message if the job seems to be hung
		set warntime 200
		if { ($deltime == $warntime) && ! [info exists ::slowJobWarn] \
			&& ! [regexp $::jobDisplaytype($guildJobId) \
			"jobmessage file no_window"] } {

		    regexp {^\S+} $::jobServer($guildJobId) dbname
		    
		    bell
		    BigMessageBox -icon warning \
			-title "guild job is taking a long time" \
			-message "Your job $::jobServerId($guildJobId) has now\
			been running for $warntime seconds, and it is unusual\
			for a database query to take this long.  Possible\
			reasons include:\n \
			* Your job may naturally take a long time to run (e.g.\
			if it is an unusually complex database query, or if it\
			is a dataPipeline job or some other type of\
			long-running job).\n \
			* LDAS may be heavily loaded at the current time, so\
			that jobs are \"throttled\" (execution delayed).\n \
			* You may be using guild from behind a firewall (or\
			some other nontrivial kind of router) which prevented\
			LDAS from notifying you when your job finished. \
			(See below.)\n\nYou may wish to check the\
			$::jobServer($guildJobId) log file at\
			http://$::manager_ip($dbname)/ldas_outgoing/logs/LDASmanager.log.html\
			to see if job $::jobServerId($guildJobId) is truly\
			still running.  If it has finished, but you were not\
			notified, then go to the \"Connect\" menu in the main\
			guild window and set \"Use proxy server?\" to\
			\"Yes\", and try again.  If you frequently use guild\
			from a machine which is behind a firewall, set the\
			environment variable LJPROXY to \"default\" before\
			starting guild (e.g. in your .cshrc file); this\
			saves you from having to manually set the \"Use\
			proxy server?\" option each time you use\
			guild.\n\nThis message will not be repeated during\
			this guild session."
		    ;##- Set a flag so that this message does not appear again
		    set ::slowJobWarn 1
		}
	    }

	    incr nrunning
	}
    }

    if { $nrunning > 0 } {
	;##- Schedule this routine to be called again
	after 200 ElapsedLoop
    } else {
###	puts "Stopping ElapsedLoop"
    }

    update idletasks

    return
}


##=========================================================================
## Name: DisplayFile
##
## Description:
##   Main routine to parse a file containing the results of a database query
##   and display them using one of several methods.
## 
## Parameters:
##   filename -- name of the file to read, or URL to retrieve into memory
##   displaytype -- display method; see Comments
##   options -- see Comments
##
## Usage:
##   DisplayFile filename displaytype ?-label label? ?-nodelete 1?
##           ?-toplevel tl?
##
## Comments:
##   Calls various parsing routines until it finds one which succeeds in
##   parsing the file.
##   Returns the Tk pathname of the toplevel created (if any).
##   displaytype can be one of the following:
##     * scrolledtable -- full scrollable table display, suitable for
##                         displaying multiple database entries
##     * namevalue -- a two-column list of name/value pairs for a single
##                      database entry
##     * listbox -- a scrollable list of values, suitable for a query which
##                      returns a single column of values
##     * rowcount -- just shows the number of rows which match the query
## ;#ol
##   The -label option is used only with a listbox display.  If it is omitted,
##   the label above the list defaults to the form 
##     "Values of <column name> in table <table>",
##   which is appropriate when one presses a "List" button in a "build query"
##   dialog.
##   Normally, the file is automatically deleted when the display window
##   is closed, which is appropriate if it was just a temporary file from
##   an interactive database query.  But if the "-nodelete 1" option is
##   given, then the file is not deleted; this is appropriate if one had
##   opened an existing file on disk.
##   Returns the empty string if no toplevel was created for some reason.

proc DisplayFile { filename displaytype args } {
###    puts "In DisplayFile"
###    puts "filename is $filename"

    update idletasks

    if { $filename == "" || [regexp {^http:/*$} $filename] } { return "" }

    ;##- Set defaults
    set label default
    set nodelete 0
    set top ""

    ;##- Get options
    foreach { opt optval } $args {
	switch -- $opt {
	    -label { set label $optval }
	    -nodelete { set nodelete $optval }
	    -toplevel { set top $optval }
	}
    }

    ;##- Now try out various parsing routines until we find one which can
    ;##- handle this format.  Any of these parsing routines sets the 
    ;##- variables {queryText, tableName, colNames, colValueVars, nRows,
    ;##- numberOfTables} as well as lists for the values in each column
    ;##- (list names given in colValueVars).
    ;##- Return values:
    ;##-      1   parsing was successful
    ;##-     -1   error opening file
    ;##-     -2   file seems to be of the right type, but there was an
    ;##-               error during parsing.
    ;##-     -9   some other error, reported elsewhere
    set numberOfTables 0
    set parsed 0

    ;##- If there is a status window, point to the widget to update
    ;##- during parsing
    if { $top != "" } {
	set statwidget $top.parsestat
    } else {
	set statwidget ""
    }

    ;##- If the filename is really a URL, retrieve its contents into a
    ;##- global variable
    if { [string match http://* $filename] } {
###	puts "Retrieving $filename"
	if { ! [string is space $statwidget] } {
	    catch { $statwidget config -text "Retrieving file..." }
	    update idletasks
	} else {
	    UpdateStatus "Retrieving file..."
	}

	if { [catch {
	    GeturlWhole $filename -timeout 0 -blocksize 131072
	} httpvar] } {
	    if { $top != "" } {
		JobUpdate $top error "Error retrieving file\n$filename"
	    } else {
		BigMessageBox -icon error \
			-title "Error retrieving file" \
			-message "Error retrieving $filename\n$httpvar"
	    }
	    UpdateStatus
	    return ""
	}
	upvar #0 $httpvar httpstate

	;##- Parse the http response string
	regexp -- {^(\S+)\s(\S+)\s(.*)$} $httpstate(http) \
		match httpversion retcode httpstatus

	;##- Handle errors
	if { $retcode == 404 } {
###	    puts "URL not found"
	    if { $top != "" } {
		JobUpdate $top error "No document found at\n$filename"
	    } else {
		BigMessageBox -icon error \
			-title "Document not found" \
			-message "No document found at\n$filename"
	    }
	    http::cleanup $httpvar
	    UpdateStatus
	    return ""
	} else {
	    ;##- Store the results in memory, in a variable named
	    ;##- the same as the URL
	    global $filename
	    set $filename $httpstate(body)
	}
	http::cleanup $httpvar
    }

    Cursor busy
    if { ! [string is space $statwidget] } {
	if { [winfo exists $statwidget] } {
	    $statwidget config -text "Parsing file..."
##	    [winfo parent $statwidget].close config -state disabled
	} else {
	    ;##- Job status window was closed by user, so bail out
	    return ""
	}
	update idletasks
    } else {
	UpdateStatus "Parsing file..."
    }

    if {$displaytype == "channellistlistbox"} {
	set parsed [ ParseChannelList $filename  ]
	set displaytype "listbox"
    } else {

	if {$parsed == 0} { set parsed [ParseXml $filename 1 $statwidget] }
	if {$parsed == 0} { set parsed [ParseIlwd $filename] }
    }

###    puts "display type set to $displaytype"

    if {$parsed == 0} {
	if { $top != "" } {
	    JobUpdate $top error "File $filename is of an unknown type"
	} else {
	    BigMessageBox -icon error \
		    -title "Unknown file type" \
		    -message "File $filename is of an unknown type"
	}
	Cursor normal
	UpdateStatus
	return ""
    } elseif {$parsed == -1} {
	if { $top != "" } {
	    JobUpdate $top error "Error opening file $filename"
	} else {
	    BigMessageBox -icon error \
		    -title "Error opening file" \
		    -message "Error opening file $filename"
	}
	Cursor normal
	UpdateStatus
	return ""
    } elseif {$parsed == -2} {
	if { $top != "" } {
	    JobUpdate $top error "Error parsing file $filename"
	} else {
	    BigMessageBox -icon error \
		    -title "Error parsing file" \
		    -message "Error parsing file $filename"
	}
	Cursor normal
	UpdateStatus
	return ""
    } elseif {$parsed == -9} {
	;##- Error was already reported somewhere else in the code
	Cursor normal
	UpdateStatus
	return ""
    }

    ;##- If there were no tables in the file, return an error
    if { $numberOfTables == 0 } {
	if { $top != "" } {
	    JobUpdate $top error \
		    "File $filename does not contain a Table object"
	} else {
	    BigMessageBox -icon error \
		    -title "File does not contain a Table" \
		    -message \
		    "File $filename does not not contain a Table object"
	}
	Cursor normal
	UpdateStatus
	return ""
    }

    ;##- Loop over tables in the file!
    for {set itable 1} {$itable <= $numberOfTables} {incr itable} {

	if {$itable > 1} {
	    set top ""
	    set parsed [ParseXml $filename $itable]
	    if {$parsed == -2} {
		BigMessageBox -icon error \
			-title "Error parsing file" \
			-message "Error parsing table $itable\
			in file $filename"
		continue
	    }
	}

	;##- If no rows were found, override the "display type"
	if { $nRows == 0 } {
	    set displaytype "no_match"
	}

	;##- If table name is not already known, try to infer it from the query
###	puts "tableName is $tableName, queryText is $queryText"
	if { $tableName == "(unknown)" } {
	    set work [string toupper $queryText]
	    if { [string range $work 0 6] == "SELECT " } {

		set charpos [string first " FROM " $work]
		if { $charpos > 0 } {
		    set work [string range $work [expr {$charpos+6}] end]
		}

		;##- The first token is the table name
		scan [string trim $work] {%[^ ]} tableName

		;##- Trim off the schema name, unless it starts with "sys"
		if { [regexp {^(.*?)\.(.*?)$} $tableName match schema temp] } {
		    if {[string compare -nocase -length 3 $schema "sys"] !=0} {
			set tableName [string toupper $temp]
		    }
		}
	    }
	}

	;##-------------------- Display section

	;##- Strip off any display modifiers
	array set displaymod [lrange $displaytype 1 end]
	set displaytype [lindex $displaytype 0]

	switch -- $displaytype {

	    scrolledtable {

		;##- Construct the window title
		if { $tableName == "(unknown)" } {
		    set title "Table display"
		} elseif {[string equal -nocase $tableName "syscat.tables"]} {
		    set title "List of database tables"
		} elseif {[string equal -nocase $tableName "syscat.columns"]} {
		    if {[regexp {TABNAME='(.*?)'} $work match tempname]} {
			set title "Columns in table $tempname"
		    }
		} elseif { [string equal -nocase $tableName "process_params"] \
			&& [regexp -nocase \
			{^select distinct substr\(value,1,\d+\) as USER_TAG} \
			$queryText] } {
		    set title "LDAS job user tags"
		    set tableName "zzusertag"
		} else {
		    set title "Entries in table $tableName"
		}

		;##- If a "label" was specified, use it for the window title
		if { [info exists label] && $label != "default" \
			&& ! [regexp {^dbinfo:} $label] } {
		    regsub -all {\s+} $label " " title
		}

		;##- Append info about the database server and instance name
		if { [regexp {^dbinfo:(.+)$} $label match dbinfo] } {
		    append title " ($dbinfo)"
		}

		;##- See if there is a row-number offset
		if { [info exists displaymod(-rowoffset)] } {
		    set rowoffset $displaymod(-rowoffset)
		} else {
		    set rowoffset 0
		}

		;##- Create the Scrolledtable window
		set tl [DisplayScrolledtable \
			$title $colNames $colValueVars $nRows \
			-table $tableName -query $queryText \
			-file $filename -toplevel $top -rowoffset $rowoffset]

		if [winfo exists $tl] {
		    ;##- Set up a button to raise the main guild window
		    button $tl.raise -text "main" -font normhelv \
			    -padx 0 -pady 0 \
			    -command "switch -- \[wm state .\] \
			    normal {raise .} iconic {wm deiconify .}; focus ."
		    place $tl.raise -in $tl -relx 1 -rely 1 -anchor se
		}

	    }

	    namevalue {

		;##- Construct the window title
		set title "Entry in table $tableName"

		;##- Get the values into a single list
		set vallist {}
		foreach var $colValueVars {
		    lappend vallist [lindex [set $var] 0]
		}

		;##- Create the Namevalue window
		set tl [DisplayNamevalue $title $colNames $vallist \
			-toplevel $top]

	    }

	    listbox {

		;##- Construct the window title
		set title "List display"

		;##- See if the specified "label" is just DB info
		if { [regexp {^dbinfo:(.+)$} $label match dbinfo] } {
		    set label "default"
		}

		;##- If necessary, make default label to put above the list
		if { $label == "default" } {
		    set colname [lindex $colNames 0]
		    set label "Values of \"$colname\"\nin table $tableName"
		}

		;##- Append DB info if we have it
		if { [info exists dbinfo] } {
		    append label "\n($dbinfo)"
		}

		;##- Use the "label" as the title too!
		regsub -all {\s+} $label " " title
		
		;##- Get the name of the list with the (first column's) data
		upvar 0 [lindex $colValueVars 0] vallist

		;##- Create the Listbox window
		set tl [DisplayListbox $title $label $vallist \
			-file $filename -toplevel $top]

	    }

	    rowcount {
		upvar 0 [lindex $colValueVars 0] vallist		
		set nmatch [lindex $vallist 0]
		if { $top != "" } {
		    JobUpdate $top finished "$nmatch records match query"
		} else {
		    set ignore [ tk_messageBox -type ok -icon info \
			    -title "Number of matching records" \
			    -message "$nmatch records match query" ]
		}
		set tl ""
	    }

	    no_match {
		if { $top != "" } {
		    JobUpdate $top finished "No records match this query"
		} else {
		    if { $queryText != "(unknown)" } {
			set message "No records match query:\n$queryText"
		    } else {
			set message "No records match query"
		    }
		    set ignore [ tk_messageBox -type ok -icon info \
			    -title "No records match query" -message $message ]
		}
		set tl ""
	    }

	}    ;##- End of switch

	;##- If a window was created to display the information, then set up
        ;##- a binding to automatically delete the memory image of the URL,
        ;##- or the temporary file, when the window is closed/destroyed.
        ;##- If no window was created, then delete immediately.
	if { $tl != "" } {
	    if { [string match http://* $filename] } {
		;##- Binding to delete the file contents from memory
		bind $tl <Destroy> \
			"if {\"%W\"==\"$tl\" && \[info exists $filename\]}\
			{unset $filename}"
	    } elseif { $nodelete == 0 || $nodelete == "false" } {
		;##- Binding to delete the temporary file
		bind $tl <Destroy> \
			"if {\"%W\"==\"$tl\" && \[file exists $filename\]}\
			{file delete $filename}"
	    }
	} else {
	    if { [string match http://* $filename] } {
		;##- Delete the file contents from memory
		if {[info exists $filename]} {unset $filename}
	    } elseif { $nodelete == 0 || $nodelete == "false" } {
		;##- Delete the temporary file
		if {[file exists $filename]} { file delete $filename }
	    }
	}

	;##- Unset the variables containing table information; they are no
	;##- longer needed now that we have built the display widget.
	if {[info exists colValueVars]} {
	    foreach var $colValueVars { unset $var }
	    unset colValueVars
	}
	if {[info exists colNames]} { unset colNames }
	if {[info exists tableName]} { unset tableName }
	if {[info exists queryText]} { unset queryText }
	if {[info exists nRows]} { unset nRows }

    } ;##- End of for loop over multiple tables in same file

    Cursor normal
    UpdateStatus

    return $tl
}

##=========================================================================
## Name: ListboxEntryLinks
##
## Description:
##   Sets up a binding so that double-clicking on an item in a listbox
##   pastes that item into the associated entry widget in the "build query"
##   dialog.
## 
## Parameters:
##   lb -- Tk pathname for listbox widget
##   entry -- Tk pathname for associated entry widget
##   ?button? -- Tk pathname for associated button widget, if any
##   ?menu? -- Tk pathname for associated option menu, if any
##
## Usage:
##   ListboxEntryLinks lb entry ?button? ?menu?
##
## Comments:
##   Called by JobMsgHandle.
##   Additional magic:
##   * "Enables" the entry by turning the text black and selecting the 
##       associated checkbutton/radiobutton
##   * If there is already something in the entry widget, this routine adds
##       a comma so that one ends up with a comma-separated list, and
##       if the comparison type was "is", changes it to "is one of"

proc ListboxEntryLinks { lb entry {button "null"} {menu "null"} } {

    if { $lb=="" || $entry=="" } { return }

    bind $lb <Double-Button-1> [selsub {
	if {! [winfo exists $entry] } { break }
	set LBELdb1 [$entry get]
	if {$LBELdb1 != ""} { $entry insert end ", " }
	$entry insert end [lindex [regexp -inline {^\S*} [$lb get active]] 0]
	if { "$button" != "null" } {
	    $button select
	}
	$entry config -foreground black
	if {"$menu" != "null"} {
	    $menu config -foreground black
	    if {$LBELdb1 != ""} {
		switch -- [$menu cget -text] {
		    "is" { $menu.menu invoke "is one of" }
		    "is not" { $menu.menu invoke "is not any of" }
		}
	    }
	}
	[winfo toplevel $entry].queryhead.refresh invoke
    } lb entry button menu ]

    return
}

##=========================================================================
## Name: ParseChannelList
##
## Description:
##   Routine to parse a file containing a channel list generated by LDAS.
##   Returns a status code indicating whether the file was parsed.
## 
## Parameters:
##   filename -- name of file to open and parse, or URL memory image to parse
##
## Usage:
##   ParseChannelList filename nvalues
##
## Comments:
##
##   Stores the table information in Tcl lists in the scope of the calling
##   routine (DisplayFile).
##
##   Returns 1 if parsing was successful, 0 if the file does not seem to be
##   parsable, -1 if there was an error opening the file

proc ParseChannelList { filename } {
    ;##- Connect certain variables to scope of calling routine
    upvar 1 queryText queryText \
	    tableName tableName \
	    colNames colNames \
	    colValueVars colValueVars \
	    nRows nRows \
	    numberOfTables numberOfTables

    ;##- Set some defaults
    set queryText "(unknown)"
    set tableName "(unknown)"
    set nRows 0
    set numberOfTables 1

    if { [string match http://* $filename] } {
	;##- Access the memory image of the URL contents
	upvar #0 $filename contents
    } else {
	;##- Open the file for reading
	if { [catch {open $filename r} fhandle] } {
	    BigMessageBox -icon error \
		    -title "Error opening file" \
		    -message "Error opening file $filename\n$fhandle"
	    return -9
	}
	if { $fhandle == "" } { return -1 }
	set contents [read $fhandle]
	catch {close $fhandle}
    }

    set columnName Channel
    set vallist colValues$columnName
    upvar 1 $vallist $vallist
    lappend colValueVars $vallist
    set $vallist [ list ]

    #-- Figure out whether information is flat or structured
    if { [llength [lindex $contents 0]] == 1 } {
	#-- Old-style flat info
	foreach { name rate } $contents {
	    lappend $vallist "$name $rate"
	    incr nRows
	}
    } else {
	#-- Structured list in LDAS 0.8 and later
	foreach item $contents {
	    foreach {name type} $item break
	    if { [regexp {sampleRate=(\S+)} $item match rate] } {
		lappend $vallist "$name $type $rate"
	    } else {
		lappend $vallist "$name $type"
	    }
	    incr nRows
	}
    }
    set $vallist [lsort [set $vallist]]
    return 1
}

##=========================================================================
## Name: ParseXml
##
## Description:
##   Routine to parse a LIGO_LW XML file.
##   Returns a status code indicating whether the file was parsed.
## 
## Parameters:
##   filename -- name of file to open and parse, or URL memory image to parse
##
## Usage:
##   ParseXml filename
##
## Comments:
##   Currently can handle files containing one or more Table objects, with
##   the data represented in the "Column Column Column ... Stream"
##   model.  Other table representations could be handled in the future if
##   necessary; the routine does already keep track of the full XML object
##   tree, it just doesn't use this information very intelligently right now.
##
##   Calls BuildXmlParser to build a proc on-the-fly to parse the Stream data
##   for each table in the file, according to the column names and data types
##   specified by the Column objects.  Then turns 'eval' loose on the proc.
##
##   Stores the table information in Tcl lists in the scope of the calling
##   routine (DisplayFile).
##
##   Parses the table comment to extract the SQL query which generated the
##   file.
##
##   Returns 1 if parsing was successful, 0 if the file does not seem to be
##   in LIGO_LW format, -1 if there was an error opening the file, or -2
##   if the file seems to be in LIGO_LW format but there was an error during
##   parsing.

proc ParseXml { filename tableWanted {statwidget ""} } {

    ;##- Connect certain variables to scope of calling routine
    upvar 1 queryText queryText \
	    tableName tableName \
	    colNames colNames \
	    colValueVars colValueVars \
	    nRows nRows \
	    numberOfTables numberOfTables

    ;##- Set some defaults
    set queryText "(unknown)"
    set tableName "(unknown)"
    set nRows 0
    set ncols 0

    ;##- Check whether this is an XML file

    if { [string match http://* $filename] } {
	;##- Access the memory image of the URL contents
	upvar #0 $filename contents
	if { ! [string equal -nocase [string range $contents 0 4] "<?xml"] } {
	    ;##- Not the right format!
	    return 0
	}
    } else {
	;##- Open the file for reading
	if { [catch {open $filename r} fhandle] } {
	    BigMessageBox -icon error \
		    -title "Error opening LIGO_LW file" \
		    -message "Error opening LIGO_LW file $filename\n$fhandle"
	    return -9
	}
	if { $fhandle == "" } { return -1 }

	;##- Read the first line of the file to determine the file type
	gets $fhandle firstline

	;##- Check whether this file can be parsed by this routine
	if { ! [string equal -nocase -length 5 $firstline "<?xml"] } {
	    ;##- Not the right format!
	    close $fhandle
	    return 0
	}

	;##- Close the file, then re-open it to start anew
	close $fhandle
	set fhandle [open $filename r]
	set contents [read $fhandle]
	catch {close $fhandle}
    }

    ;##- Initialize the counters for "tag level" (>0 means we are inside a tag
    ;##- itself, i.e. between the "<" and the ">") and "container level" (the
    ;##- number of levels deep we are in nested start-tag/end-tag pairs).
    set taglevel 0
    set contlevel 0

    ;##- Initialize the counters for the number of instances of containers at
    ;##- each level
    set maxcontlevel 20
    for {set ilevel 0} {$ilevel <= $maxcontlevel} {incr ilevel} {
	set instances($ilevel) 0
    }

    ;##- Initialize the table counter
    set tableNumber 0

    update idletasks

    ;##- Split the file contents into an array, breaking at every "<", and 
    ;##- loop over these chunks.  (But skip the first chunk, which is blank.)
    ;##- This is one of the slow parts of parsing.  Using 'split' instead of
    ;##- 'regexp' seems to take about the same amount of time.
    set firstchunk 1
    foreach chunk [regexp -all -inline -- {[^<]+} $contents] {
	if {$firstchunk == 1} {
###	    puts "First chunk is _${chunk}_"
	    set firstchunk 0
	    continue
	}

	incr taglevel 1
###	puts "c $taglevel   Chunk: ."

	;##- If we are at root level, figure out what kind of tree we 
	;##- are starting
	if {$taglevel == 1 && $contlevel == 0} {
	    switch -- [string index $chunk 0] {
		"" { set treetype null }
		"?" { set treetype xmlhead }
		"!" { set treetype xmldtd }
		default { set treetype xmldata }
	    }
###	    puts "==> Set treetype to $treetype"
	}

	if { $treetype == "xmldata" } {

	    ;##- Split the chunk at every ">", and loop
	    incr taglevel
	    foreach item [regexp -all -inline -- {(?:[^>]+|>\Z)} $chunk] {
		incr taglevel -1
		if { $item == ">" } { continue }
###		puts " o t=$taglevel c=$contlevel Item: $item."

		if {$taglevel < 0} {
		    BigMessageBox -icon error \
			    -title "Angle bracket mismatch in LIGO_LW file" \
			    -message "Angle bracket mismatch (more '>' than\
			    '<') in LIGO_LW file $filename"
		    return -2
		}

		if {$item == "" && $taglevel > 0} {
		    ;##- Error: null tag
		    BigMessageBox -icon error \
			    -title "Null tag in LIGO_LW file" \
			    -message "Encountered null tag (<>)\
			    in LIGO_LW file $filename"
		    return -2
		}

		if {$taglevel > 0} {
		    ;##- Handle tag
###		    puts "   Tag c=$contlevel: $item"
		    switch -- [string index $item 0] {
			"\n" {}
			"/" { incr contlevel -1; set container "" }
			default {
			    incr contlevel
			    if {$contlevel > $maxcontlevel} {
				;##- Containers nested by too many levels
				BigMessageBox -icon error \
					-title "Too many container levels" \
					-message "LIGO_LW file $filename\
					exceeds $maxcontlevel container
					levels!"
				return -2
			    }

			    ;##- Figure out if this tag will have a 
			    ;##- matching end-tag
			    if {[string index $item end] == "/"} {
				;##- There will not be a matching end-tag, so
				;##- after we are done handling this tag, we
				;##- should decrement contlevel
				set item [string range $item 0 end-1]
				set delcontlevel -1
			    } else {
				;##- There will be a matching end-tag
				set delcontlevel 0
			    }

			    ;##- Record information about this container
			    incr instances($contlevel)
			    set index $contlevel,$instances($contlevel)
			    set instance($index) $item
			    set parent($index) \
				    $instances([expr {$contlevel-1}])
			    set firstchild($index) \
				    [expr {$instances([expr $contlevel+1])+1}]

			    ;##- Extract the container name
			    set taginfo $item
			    scan $item {%[^ ]} container
			    if { $contlevel == 2 && $container == "Table" } {
				incr tableNumber
				if { $tableNumber == $tableWanted } {
				    set tableName "(unknown)"
				    #-- Try to determine the table name
				    if [regexp -nocase \
					        { Name="[^:]+:([^:]+):table"} \
					        $item - tempName] {
					if { ! [string equal -nocase $tempName\
						  "result_table"] } {
					    set tableName $tempName
					}
				    }
				}
			    }

			    ;##- Now update the container level counter
			    incr contlevel $delcontlevel

			}

		    } ;##- End of switch

		    if {$contlevel < 0} {
			BigMessageBox -icon error \
				-title "Start/end tag inconsistency" \
				-message "Found end-tag without matching\
				start-tag in LIGO_LW file $filename"
			return -2
		    }

		} elseif {$container == "Comment"} {

		    if { $tableNumber == $tableWanted || $tableNumber == 0 } {
###			puts "Comment is $item"
			if {[string range $item 0 3] == "SQL="} {
			    ;##- Trim off the "SQL="
			    regsub -nocase {^SQL=} $item {} item
			}
			set queryText [string map \
				    { &lt; < &gt; > &apos; ' &amp; & } $item]
###			puts "SQL query text is $queryText"
		    }

		} elseif { ! [string is space $item] \
			&& $tableNumber == $tableWanted } {
		    ;##- Handle data
###		    puts "Data: $item."

		    ;##- Check the container type to figure out how to parse
		    if {$container == "Stream"} {
###			puts "Found a stream"

			update idletasks

			;##- Get the delimeter (default to a comma)
			set delim ","
			foreach attrib [split $taginfo] {
			    if {[regexp {([^=]*)=([^=]*)} $attrib \
				    match name value]} {
				if {$name == "Delimiter"} {
				    set delim [string trim $value \"]
				}
			    }
			}
###			puts "Delimiter is $delim"

			set parent_index [expr $contlevel-1],$parent($index)

			;##- Figure out the table name
##-- Comment this out, since LDAS no longer puts the table name into the Name
##-- attribute of the <Table> container.  We'll determine it from the SQL
##-- text elsewhere in the code.
##			set component $instance($parent_index)
##			foreach attrib [split $component] {
##			    if {[regexp {Name="(.*?)"} $attrib match value]} {
##				foreach part [split $value :] {
##				    if {![regexp \
##					    {^(ldasgroup|row|data|table)$} \
##					    $part]} {
##					set tableName [string tolower $part]
##				    }
##				}
##			    }
##			}

			;##- Figure out what columns are included in table
			set colNames {}
			set colTypes {}
			for {set iin $firstchild($parent_index)} \
				{$iin < $instances($contlevel)} \
				{incr iin} {
			    set component $instance($contlevel,$iin)
			    scan $component {%[^ ]} container
			    if {$container != "Column"} { continue }

			    ;##- Found a column

			    ;##- Get column attributes
			    if {[info exists columnName]} {unset columnName}
			    if {[info exists columnType]} {unset columnType}
			    if {[info exists columnUnit]} {unset columnUnit}
			    foreach attrib [split $component] {
				if {[regexp {([^=]*)=([^=]*)} $attrib \
					match attname attvalue]} {
				    set column$attname \
					    [string trim $attvalue \"]
				}
			    }

			    ;##- Strip off the interesting part of the column
			    ;##- name, after the final colon (if any)
			    regexp {.*?([^:]+)$} $columnName match columnName

			    ;##- Make sure the column name starts with a letter
			    if { ! [regexp {^[A-Za-z_]} $columnName] } {
				set columnName "col$columnName"
			    }

			    lappend colNames $columnName
			    lappend colTypes $columnType
###			    puts "Column $columnName, type $columnType"

			    ;##- "Export" the value-list variable to the
			    ;##- calling routine, and record its name
			    set vallist colValues${columnName}_col$ncols
			    upvar 1 $vallist $vallist
			    lappend colValueVars $vallist
			    incr ncols
			}

			;##- Build a specialized proc to parse the stream
###			puts "Building proc"
			set procname "proc[clock seconds]_$tableNumber"
			set proctext [BuildXmlParser \
				$procname $colNames $colTypes $colValueVars \
				$delim $statwidget]
###			puts "Proc has been built"
###			puts "\nProc text is: $proctext\n"

			update idletasks

			;##- Evaluate the proc
			eval $proctext
###			puts "Proc has been compiled"

			;##- Now parse the Stream by executing the proc
###			puts "Parsing Stream..."
			set nRows [$procname]
###			puts "nRows is $nRows"

###			;##- Check the parsed values
###			foreach colname $colNames vallist $colValueVars {
###			    puts "$colname = [set $vallist]"
###			}

		    } else {
			;##- Don't know how to handle data in this container
			BigMessageBox -icon error \
				-title "Unable to handle data in container" \
				-message "Don't know how to handle data in\
				a $container container.  Sorry!  Ask Peter\
				to modify the code!"
			return -9
		    } ;##- End of switch on container type

		} ;##- End of if/then for tag vs. data

	    } ;##- End of "foreach item ..."

	} else {

	    ;##- Split the chunk at every ">", and loop
	    incr taglevel
	    foreach item [regexp -all -inline -- {(?:[^>]+|>\Z)} $chunk] {
		incr taglevel -1
		if { $item == ">" } { continue }
###		puts " o t=$taglevel c=$contlevel Cont: $item."

		if {$taglevel < 0} {
		    BigMessageBox -icon error \
			    -title "Angle bracket mismatch in LIGO_LW file" \
			    -message "Angle bracket mismatch (more '>' than\
			    '<') in LIGO_LW file $filename"
		    return -2
		}
	    }

	} ;##- End of "if {$treetype=="xmldata"} {...} else {...}"
    } ;##- End of "foreach chunk ..."

    ;##- Check that the file ends gracefully
###    puts "At end, taglevel=$taglevel, contlevel=$contlevel"
    if {$taglevel == 1 && $contlevel == 0} {
	;##- It looks like there is just a final ">" missing.  This can
	;##- happen if the file does not end with a newline.  So don't
	;##- report an error.
    } elseif {$contlevel != 0} {
	set ignore [ tk_messageBox -type ok -icon warning \
		-title "LIGO_LW file ends prematurely" \
		-message "WARNING: LIGO_LW file $filename seems to end\
		prematurely, with $contlevel open container level(s)"]
    } elseif {$taglevel != 0} {
	set ignore [ tk_messageBox -type ok -icon warning \
		-title "LIGO_LW file ends in middle of a tag" \
		-message "WARNING: LIGO_LW file $filename seems to end\
		in the middle of an XML tag (taglevel=$taglevel)"]
    }

    if { ! [string match http://* $filename] } {
	;##- Delete the file contents from memory
	unset contents
    }

    set numberOfTables $tableNumber
    return 1   ;##- Success
}


##=========================================================================
## Name: BuildXmlParser
##
## Description:
##   Routine to build a customized proc to parse the stream data for
##   a specific table in a LIGO_LW XML file.
## 
## Parameters:
##   procname -- name of proc
##   colNames -- list of column names
##   colTypes -- list of column types
##   colValueVars -- list of global variables containing column value lists
##   delim -- Delimiter used in stream
##   ?statwidget? -- (Optional) widget in which parsing status
##       should be displayed
##
## Usage:
##   BuildXmlParser procname colNames colTypes colValueVars delim ?statwidget?
##
## Comments:
##   Builds a proc to parse the Stream data, according to the
##   column names and data types specified by the preceding Column
##   objects.  In the stream, text items (lstring, ilwd:char, ilwd:char_u)
##   must be surrounded by double quotes, unless they are null, in which
##   case the double quotes may be omitted.  Every item, except for the
##   last one in the stream, must be followed immediately by the delimiter
##   (usually a comma) with no intervening whitespace.  (It is OK if there
##   is also a delimiter after the last item in the stream.)  However, LEADING
##   whitespace (including newlines) before any item is ignored; thus, for
##   instance, there can be newlines between items for a given row, and
##   the data for a row need not end with a newline.
##
##   Returns the proc text.

proc BuildXmlParser { procname colNames colTypes colValueVars delim
        {statwidget ""} } {

    set proctext "proc $procname {} {\n"
    append proctext "  set BXPnrows 0\n"

    ;##- Use "upvar" to circumvent normal scoping
    append proctext "  upvar 1 item BXPstream"
    foreach vallist $colValueVars {
	append proctext " $vallist $vallist"
    }
    append proctext "\n"

    append proctext {  set totLength [string length $BXPstream]} "\n"
###    append proctext {  puts "Length of stream is $totLength"} "\n"
    append proctext {  set soFar 0} "\n"

    ;##- Construct the regular expression with which
    ;##- to break up the stream into data elements

    set linepat ""
    set icol 0
    set ncols [llength $colNames]
    foreach colname $colNames coltype $colTypes {
	incr icol
	switch -- $coltype {

	    "lstring" -
	    "ilwd:char" -
	    "ilwd:char_u" {
		if {$icol < $ncols} {
		    ;##- Data element may consist of:
		    ;##-   * A string between quotes
		    ;##-   * Two quotes only (empty string)
		    ;##-   * Nothing at all (null string)
		    ;##- In each case it is followed by the delimiter
		    ;##- (normally a comma).
		    append linepat [ string map [list , $delim] \
			    {\s*?(".*?"\s*,|,)} ]
		    ##append linepat [ string map [list , $delim] \
			    {\s*((?:[^,\\]|\\.)*,)} ]
		} else {
		    ;##- For the last column, the data element will be
		    ;##- followed EITHER by the delimiter OR by the
		    ;##- end-of-string.
		    ;##- Note workaround for "regexp -all" bug in Tcl/Tk 8.3.0.
		    if {[info patchlevel] == "8.3.0"} {
			append linepat [ string map [list , $delim] \
				{\s*?(".*?"\s*,|,|".*?"\s*\Z|\s+\Z)} ]
		    } else {
			append linepat [ string map [list , $delim] \
				{\s*?(".*?"\s*,|,|".*?"\s*\Z|\s*\Z)} ]
		    }
		}
	    }

	    default {
		if {$icol < $ncols} {
		    ;##- Data element may consist of:
		    ;##-   * A numerical value
		    ;##-   * Nothing at all (null value)
		    ;##- In each case it is followed by the delimiter
		    ;##- (normally a comma).
		    append linepat [ string map [list , $delim] \
			    {\s*?([^,\s]+\s*,|,)} ]
		} else {
		    ;##- For the last column, the data element will be
		    ;##- followed EITHER by the delimiter OR by the
		    ;##- end-of-string.
		    ;##- Note workaround for "regexp -all" bug in Tcl/Tk 8.3.0.
		    if {[info patchlevel] == "8.3.0"} {
			append linepat [ string map [list , $delim] \
				{\s*?([^,\s]+\s*,|,|[^,\s]+\s*\Z|\s+\Z)} ]
		    } else {
			append linepat [ string map [list , $delim] \
				{\s*?([^,\s]+\s*,|,|[^,\s]+\s*\Z|\s*\Z)} ]
		    }
		}
	    }
	}
    }

###    append proctext "puts \"BXPstream is \$BXPstream.\"\n"

    ;##- Now put the regexp expression into the proc
    append proctext "  foreach {BXPmatch"
    foreach colname $colNames {
	append proctext " $colname"
    }
    append proctext \
	    "} \[regexp -all -inline -- {" $linepat "} \$BXPstream\] {\n"
    append proctext "    incr BXPnrows\n"

###    puts "linepat is: $linepat\n"

    ;##- In the proc, add lines to append each value to a list,
    ;##- with translation if necessary (depending on type).
    ;##- The ilwd:char_u translation is the slow part!

    set icol 0
    foreach colname $colNames coltype $colTypes vallist $colValueVars {
	incr icol
	switch -- $coltype {

	    "lstring" {
		set maplist { "\n" {\n} "\t" {\t} {\,} , \
			&lt; < &gt; > &amp; & }

		;##- Extract string from within quotes (trimming trailing
		;##- whitespace), then do map translations

		append proctext [subbut {   \
    if { [regsub {^"(.*\S)\s*"[$delim\s]*$} $$colname {\1} $colname] } {
      lappend $vallist [string map {$maplist} $$colname]
    } else {
      lappend $vallist {}
    }\
		} ] "\n"

	    }

	    "ilwd:char" {
		set maplist { "\n" {\n} "\t" {\t} {\\} \\ {\ } { } {\,} , \
			&lt; < &gt; > &amp; & }

		;##- Extract string from within quotes, discard bare spaces,
                ;##- do map translations, and trim

		append proctext [subbut {   \
    if { [regsub {^"(.*)"[$delim\s]*$} $$colname {\1} $colname] } {
      regsub -all {([^\\]) } $$colname {\1} $colname
      lappend $vallist [string trim [string map {$maplist} $$colname]]
    } else {
      lappend $vallist {}
    }\
		} ] "\n"
	    }

### Code fragment for converting representations with octal to hex
### if {[string index $colname 0] == \\} { ;##- NOT NECESSARILY TRUE FOR MIXED!
###	set BXPwork x'
###	if {[regexp {[^\\] } $colname]} {
###	    foreach BXPval [regexp -all -inline {([^ ]*|\\ )} $colname] {
###		if {[regexp {\\([0-7]{3})} $BXPval BXPmatch BXPval]} {
###		    append BXPwork [format %02x 0$BXPval]
###		} else {
###		    binary scan [string map $maplist $BXPval] c BXPval
###		    append BXPwork [format %02x $BXPval]
###		}
###	    }
###	} else {
###	    foreach BXPval [regexp -all -inline {[0-7]+} $colname] {
###		append BXPwork [format %02x 0$BXPval]
###	    }
###	}
###	append BXPwork '
### } else {
###	lappend $vallist [string map $maplist $$colname]
### }

	    "ilwd:char_u" {

		append proctext [subbut {   \
    if { [regsub {^"(.+)"[$delim\s]*$} $$colname {\1} $colname] } {
      set BXPwork x'
      if {[string index $$colname 0] == "\\"} {
        foreach BXPval [regexp -all -inline {[0-7]{3}} $$colname] {
          append BXPwork [format %02x 0$BXPval]
        }
      } else {
        foreach BXPval [regexp -all -inline {[1-9][0-9]*} $$colname] {
          append BXPwork [format %02x $BXPval]
        }
      }
      append BXPwork '
      lappend $vallist $BXPwork
    } else {
      lappend $vallist {}
    }\
		} BXPwork BXPval ] "\n"

	    }

	    default {

		append proctext [subbut {   \
    if { [regsub {^(.*?)[$delim\s]*$} $$colname {\1} $colname] } {
      lappend $vallist [string trim $$colname]
    } else {
      lappend $vallist {}
    }\
		} ] "\n"

	    }

	}  ;##- End of switch
    }  ;##- End of loop over columns

    append proctext {    incr soFar [string length $BXPmatch]} "\n"
    if { ! [string is space $statwidget] } {
	;##- Periodically update the status widget
        append proctext "    if { \$BXPnrows % 50 == 0 } {\
		catch { $statwidget config -text \"Parsed \$BXPnrows rows\
		(\[expr {100*\$soFar/\$totLength}\]\%)...\";\
		update idletasks } }\n"
    } else {
	append proctext "    if { \$BXPnrows % 50 == 0 } {\
		UpdateStatus \"Parsed \$BXPnrows rows\
		(\[expr {100*\$soFar/\$totLength}\]\%)...\" }\n"
    }

    ;##- Close the foreach over rows
    append proctext "  }\n"
			
    if { ! [string is space $statwidget] } {
	;##- Update the status widget
        append proctext "    catch { $statwidget config\
		-text \"Parsed \$BXPnrows rows (100\%)\" }\n"
	append proctext "    update idletasks\n"
    } else {
	append proctext "    UpdateStatus \"Building table...\"\n"
    }

    ;##- Finish up the proc
    append proctext "  return \$BXPnrows\n"
    append proctext "}\n"

    return $proctext
}


##=========================================================================
## Name: ParseIlwd
##
## Description:
##   Routine to parse an ilwd file.
##   Returns a status code indicating whether the file was parsed.
## 
## Parameters:
##   filename -- name of file to open and parse, or URL memory image to parse
##
## Usage:
##   ParseIlwd filename
##
## Comments:
##   Stores the table information in Tcl lists in the scope of the calling
##   routine (DisplayFile).
##
##   Parses the table comment to extract the SQL query which generated the
##   file.
##
##   Returns 1 if parsing was successful, 0 if the file does not seem to be
##   in ilwd format, -1 if there was an error opening the file, or -2
##   if the file seems to be in ilwd format but there was an error during
##   parsing.

proc ParseIlwd { filename } {

    ;##- Connect certain variables to scope of calling routine
    upvar 1 queryText queryText \
	    tableName tableName \
	    colNames colNames \
	    colValueVars colValueVars \
	    nRows nRows \
	    numberOfTables numberOfTables

    ;##- Set some defaults
    set queryText "(unknown)"
    set tableName "(unknown)"
    set nRows 0
    set ncols 0
    set colNames {}

    ;##- Check whether this is an ILWD file

    if { [string match http://* $filename] } {
	;##- Access the memory image of the URL contents
	upvar #0 $filename contents
	if { ! [string equal -nocase [string range $contents 0 5] "<?ilwd"] } {
	    ;##- Not the right format!
	    return 0
	}
	set fhandle "noChannel"
    } else {
	;##- Open the file for reading
	if { [catch {open $filename r} fhandle] } {
	    BigMessageBox -icon error \
		    -title "Error opening ILWD file" \
		    -message "Error opening ILWD file $filename\n$fhandle"
	    return -9
	}
	if { $fhandle == "" } { return -1 }

	;##- Read the first line of the file to determine the file type
	gets $fhandle firstline

	;##- Check whether this file can be parsed by this routine
	if { ! [string equal -nocase -length 5 $firstline "<?ilwd"] } {
	    ;##- Not the right format!
	    close $fhandle
	    return 0
	}

	;##- Close the file, then re-open it to start anew
	close $fhandle
	set fhandle [open $filename r]
	set contents [read $fhandle]
	catch {close $fhandle}
    }

    ;##- Initialize the counters for "tag level" (>0 means we are inside a tag
    ;##- itself, i.e. between the "<" and the ">") and "container level" (the
    ;##- number of levels deep we are in nested start-tag/end-tag pairs).
    set taglevel 0
    set contlevel 0
    array set contstack [list -2 invalid -1 invalid 0 root]

    ;##- Initialize the counters for the number of instances of containers at
    ;##- each level
    set maxcontlevel 20
    for {set ilevel 0} {$ilevel <= $maxcontlevel} {incr ilevel} {
	set instances($ilevel) 0
    }

    ;##- Initialize the table counter
    set tableNumber 0

    update idletasks

    ;##- Split the file contents into an array, breaking at every "<", and 
    ;##- loop over these chunks.  (But skip the first chunk, which is blank.)
    set firstchunk 1
    foreach chunk [regexp -all -inline -- {[^<]+} $contents] {
	if {$firstchunk == 1} {
	    set firstchunk 0
	    continue
	}

	incr taglevel
###	puts "c t=$taglevel   Chunk: $chunk."

	;##- If we are at root level, figure out what kind of tree we 
	;##- are starting
	if {$taglevel == 1 && $contlevel == 0} {
	    switch -- [string index $chunk 0] {
		"" { set treetype null }
		"?" { set treetype ilwdhead }
		default { set treetype ilwddata }
	    }
###	    puts "==> Set treetype to $treetype"
	}

	if { $treetype == "ilwddata" } {

	    ;##- Split the chunk at every ">", and loop
	    incr taglevel
	    foreach item [regexp -all -inline -- {(?:[^>]+|>\Z)} $chunk] {
		incr taglevel -1
		if { $item == ">" } { set item "" }
###		puts " o t=$taglevel c=$contlevel Item: $item."

		if {$taglevel < 0} {
		    BigMessageBox -icon error \
			    -title "Angle bracket mismatch in ilwd file" \
			    -message "Angle bracket mismatch (more '>' than\
			    '<') in ilwd file $filename"
		    return -2
		}

		if {$item == "" && $taglevel > 0} {
		    ;##- Error: null tag
		    BigMessageBox -icon error \
			    -title "Null tag in ilwd file" \
			    -message "Encountered null tag (<>)\
			    in ilwd file $filename"
		    return -2
		}

		;##- Translate XML "entities"
		set item [string map { &lt; < &gt; > &amp; & } $item]

		if {$taglevel > 0} {
		    ;##- Handle tag
###		    puts "   Tag c=$contlevel: $item"
		    switch -- [string index $item 0] {
			"\n" {}
			"/" {
			    incr contlevel -1
			    set container $contstack($contlevel)
			}
			default {
			    incr contlevel
			    if {$contlevel > $maxcontlevel} {
				;##- Containers nested by too many levels
				BigMessageBox -icon error \
					-title "Too many container levels" \
					-message "ilwd file $filename\
					exceeds $maxcontlevel container\
					levels!"
				return -2
			    }

			    ;##- At present, we can only handle a single
			    ;##- table container in a file
			    if {$contlevel == 2} {
				incr tableNumber
				if { $tableNumber > 1 } {
				    BigMessageBox -icon error \
					    -title "Too many ilwd objects" \
					    -message "ilwd file $filename\
					    has more than one ilwd object\
					    inside the outermost container. \
					    guild cannot handle this - sorry!"
				    return -2
				}
			    }

			    ;##- Figure out if this tag will have a 
			    ;##- matching end-tag
			    if {[string index $item end] == "/"} {
				;##- There will not be a matching end-tag, so
				;##- after we are done handling this tag, we
				;##- should decrement contlevel
				set item [string range $item 0 end-1]
				set delcontlevel -1
			    } else {
				;##- There will be a matching end-tag
				set delcontlevel 0
			    }

			    ;##- Record information about this container
			    incr instances($contlevel)
			    set index $contlevel,$instances($contlevel)
			    set instance($index) $item
			    set parent($index) \
				    $instances([expr {$contlevel-1}])
			    set firstchild($index) \
				    [expr {$instances([expr $contlevel+1])+1}]

			    ;##- Extract the container type
			    set taginfo $item
			    scan $item {%[^ ]} container
			    set contstack($contlevel) $container
###			    puts "     Level $contlevel Container: $container"

			    ;##- Clear the null-mask
			    if {$contlevel == 3} {
				set nullmask ""
			    }

			    ;##- Get the name of this container
			    foreach attrib [regexp -all -inline \
				    {\S*='[^']*'} $taginfo] {
###				puts "  Attrib: $attrib"
				if {[regexp {([^=]*)='([^']*)'} $attrib \
					match name value]} {
###				    puts "    $contlevel Name= $name"
				    if {$contlevel == 1 || $contlevel == 2} {
					if {$name == "comment"} {
					    if { [string range $value 0 3] \
						     == "SQL="} {
						;##- Trim off the "SQL="
						regsub -nocase {^SQL=} \
						        $value {} value
					    }
					    set queryText [string map \
						    { &lt; < &gt; >\
						    &apos; ' &amp; & } $value]
###					    puts "  query is $queryText"
					}
				    } elseif {$contlevel == 3} {
					if {$name == "name"} {
					    set colname $value

					    ;##- Make sure the column name
					    ;##- starts with a letter
					    if { ! [regexp {^[A-Za-z_]} \
						    $colname] } {
						set colname "col$colname"
					    }

					    lappend colNames $colname
###					    puts "  column name is $colname"

					    ;##- "Export" the value-list
					    ;##- variable to the calling
					    ;##- routine, and record its name
					    set vallist \
						  colValues${colname}_col$ncols
					    upvar 1 $vallist $vallist
					    set $vallist {}
					    lappend colValueVars $vallist
					    incr ncols
					} elseif {$name == "nullmask"} {
					    set nullmask $value
					}
				    }
				}
			    }

			    ;##- Now update the container level counter
			    incr contlevel $delcontlevel
			    set container $contstack($contlevel)

			}

		    } ;##- End of switch

		    if {$contlevel < 0} {
			BigMessageBox -icon error \
				-title "Start/end tag inconsistency" \
				-message "Found end-tag without matching\
				start-tag in ilwd file $filename"
			return -2
		    }

		} else {
		    ;##- Handle data
###		    puts "   Data: $item"

		    ;##- Check the container type to figure out how to parse
		    if {$contlevel == 4 && $container == "char_u"} {
###			puts "--> char_u item"
			if { $item == "" } {
			    lappend $vallist ""
			} else {
			    set work x'
			    if {[string index $item 0] == "\\"} {
				;##- Octal values
				foreach val [regexp -all -inline \
					{[0-7]{3}} $item] {
				    append work [format %02x 0$val]
				}
			    } else {
				;##-Space-separated decimal values (old format)
				foreach val [regexp -all -inline \
					{[1-9][0-9]*} $item] {
				    append work [format %02x $val]
				}
			    }
			    append work '
			    lappend $vallist $work
			}

		    } elseif {$contlevel == 4 && $container == "char"} {
###			puts "--> char item"

			lappend $vallist $item

		    } elseif {$contlevel == 4} {

			BigMessageBox -icon error \
				-title "Unable to handle data in container" \
				-message "Don't know how to handle data in\
				a $container container at level 4 in an ilwd\
				file.  Sorry!  Ask Peter to modify the code!"
			return -9   ;##- Error

		    } elseif {$container == "lstring"} {
###			puts "--> lstring row"

###			set $vallist \
###				[regexp -all -inline -- {.*?(?!\\,)} $item]

###			set $vallist {}
###			foreach val [regexp -all -inline {.*?(?!\\,)} $item] {
###			    lappend $vallist $val
###			}

			;##- Split at the \, combination
			set $vallist {}
			while {[regexp -- {([^\\]*)\\,(.*)} $item \
				match val rest]} {
			    lappend $vallist [string trim $val]
			    set item $rest
			}
			lappend $vallist [string trim $item]

###			puts "Values: [set $vallist]"

		    } elseif { $container == "ilwd" } {

			if { ! [string is space $item] } {
			    BigMessageBox -icon error \
				    -title "Found data for ilwd container???" \
				    -message "Found ordinary data for an ilwd\
				    container???  This shouldn't happen; an\
				    ilwd container should only contain other\
				    containers.  Parsing aborted!"
			    return -2   ;##- Error
			}

		    } elseif { $container != "root" } {
###			puts "--> misc row"

			if {[string equal $nullmask ""]} {
			    ;##- Just split at spaces
			    set $vallist [regexp -all -inline {\S+} $item]
###			    puts "Values: [set $vallist]"
			} else {
			    ;##- Decode null mask to a binary string
			    set binmask [BinaryNullMask $nullmask]

			    ;##- Loop over rows, appending value or null
			    ;##- NOTE: It might be faster to do the ival
			    ;##- loop as part of the foreach, using
			    ;##- [split $binmax {}].
			    set $vallist {}
			    set ival -1
			    foreach val [regexp -all -inline {\S+} $item] {
				incr ival
				if {[string index $binmask $ival]} {
				    lappend $vallist ""
				} else {
				    lappend $vallist $val
				}
			    }
			}

		    }  ;##- End of branching based on container type

		}  ;##- End of if (tag vs. data)

	    }  ;##- End of "foreach item ..."

	} else {

	    ;##- Split the chunk at every ">", and loop
	    incr taglevel
	    foreach item [regexp -all -inline -- {(?:[^>]+|>\Z)} $chunk] {
		incr taglevel -1
		if { $item == ">" } { set item "" }
###		puts " o t=$taglevel c=$contlevel Cont: $item."

		if {$taglevel < 0} {
		    BigMessageBox -icon error \
			    -title "Angle bracket mismatch in ilwd file" \
			    -message "Angle bracket mismatch (more '>' than\
			    '<') in ilwd file $filename"
		    return -2
		}
	    }

	} ;##- End of "if {$treetype=="ilwddata"} {...} else {...}"
    } ;##- End of "foreach chunk ..."

    ;##- Check that the file ends gracefully
###    puts "At end, taglevel=$taglevel, contlevel=$contlevel"
    if {$taglevel == 1 && $contlevel == 0} {
	;##- It looks like there is just a final ">" missing.  This can
	;##- happen if the file does not end with a newline.  So don't
	;##- report an error.
    } elseif {$contlevel != 0} {
	set ignore [ tk_messageBox -type ok -icon warning \
		-title "ilwd file ends prematurely" \
		-message "WARNING: ilwd file $filename seems to end\
		prematurely, with $contlevel open container level(s)"]
    } elseif {$taglevel != 0} {
	set ignore [ tk_messageBox -type ok -icon warning \
		-title "ilwd file ends in middle of a tag" \
		-message "WARNING: ilwd file $filename seems to end\
		in the middle of a tag (taglevel=$taglevel)"]
    }

    ;##- Count number of rows
    upvar 0 [lindex $colValueVars 0] firstvarname
    set nRows [llength $firstvarname]

    if { ! [string match http://* $filename] } {
	;##- Delete the file contents from memory
	unset contents
    }

    set numberOfTables 1
    return 1   ;##- Success
}

##=========================================================================
## Name: BinaryNullMask
##
## Description:
##   Converts an ilwd null-mask string (in base64 encoding) to a string of
##   ones in zeros, where the first character in the output string is 1 if
##   the first data element is null, etc.  (Note that the binary string has
##   a different ordering from the one with which one represents numerical
##   values.)   Returns the binary string.
## 
## Parameters:
##   b64mask -- the input null-mask
##
## Usage:
##   BinaryNullMask b64mask
##
## Comments:
##   Uses a lookup table for speed optimization.

proc BinaryNullMask { b64mask } {

    ;##- Access the lookup array
    global BNMb64lu

    ;##- Initialize the lookup array if it does not already exist
    if { ! [info exists BNMb64lu] } {
	array set BNMb64lu { \
		A 000000 B 000001 C 000010 D 000011 \
		E 000100 F 000101 G 000110 H 000111 \
		I 001000 J 001001 K 001010 L 001011 \
		M 001100 N 001101 O 001110 P 001111 \
		Q 010000 R 010001 S 010010 T 010011 \
		U 010100 V 010101 W 010110 X 010111 \
		Y 011000 Z 011001 a 011010 b 011011 \
		c 011100 d 011101 e 011110 f 011111 \
		g 100000 h 100001 i 100010 j 100011 \
		k 100100 l 100101 m 100110 n 100111 \
		o 101000 p 101001 q 101010 r 101011 \
		s 101100 t 101101 u 101110 v 101111 \
		w 110000 x 110001 y 110010 z 110011 \
		0 110100 1 110101 2 110110 3 110111 \
		4 111000 5 111001 6 111010 7 111011 \
		8 111100 9 111101 + 111110 / 111111 \
		= {} }
    }

    set binmask ""
    foreach char [regexp -all -inline {.} $b64mask] {
	append binmask $BNMb64lu($char)
    }
		
    return $binmask
}


##=========================================================================
## Name: DisplayScrolledtable
##
## Description:
##   Routine to create a new window and display table information using
##   the scrolledtable pseudo-widget.
##   Returns the Tk pathname of the toplevel widget created to display the
##   results.
## 
## Parameters:
##   title -- window title
##   colNames -- list of column names
##   colValueVars -- list of variables containing column data
##   nRows -- number of rows in table
##   tableName -- Optional table name; used to set up cross-refs and
##                     button actions
##   queryText -- Optional query text; displayed below table
##   filename -- Optional (input) filename; displayed below table, and used to
##                    construct the default name for saving the table contents
##   tl -- Optional existing toplevel in which to build table
##
## Usage:
##   DisplayScrolledtable title colNames colValueVars nRows \
##           ?-table tableName? ?-query queryText? ?-file filename? \
##           ?-toplevel tl?
##
## Comments:
##   Returns the empty string if no toplevel was created for some reason.

proc DisplayScrolledtable { title colNames colValueVars nRows args } {

    ;##- If there is no data, just return
    if {[llength $colNames] == 0} { return "" }

    ;##- Set default values of optional arguments
    set tableName ""
    set queryText ""
    set filename ""
    set tl ""
    set rowoffset 0

    ;##- Parse optional arguments
    foreach { opt optval } $args {
	switch -- $opt {
	    -table { set tableName $optval }
	    -query { set queryText $optval }
	    -file { set filename $optval }
	    -toplevel { set tl $optval }
	    -rowoffset { set rowoffset $optval }
	}
    }

    ;##- Map "(unknown)" to "" for the optional arguments
    if { $tableName == "(unknown)" } { set tableName "" }
    if { $queryText == "(unknown)" } { set queryText "" }
    if { $filename == "(unknown)" } { set filename "" }

    ;##- Get access to lists containing the table data
    foreach vallist $colValueVars {
	upvar 1 $vallist $vallist
    }

    ;##- Create a new window to display the table
    if { [string is space $tl] || ! [winfo exists $tl] } {
	set tl [NewToplevel]

	if {$::winIcons} {
	    ;##- Also create an icon for this window
	    NewToplevel ${tl}Icon -icon -width 48 -height 48 \
		    -highlightthickness 0
	    label ${tl}Icon.bitmap -image tableIcon
	    pack ${tl}Icon.bitmap -side top -fill x
	    wm iconwindow $tl ${tl}Icon
	}

    } else {
	foreach widget [winfo children $tl] { destroy $widget }
    }

    ;##- Set the window title
    wm title $tl $title
    ;##- Set the icon name too
    set iconname $title
    regsub {^Entries in table } $iconname {} iconname
    regsub {^Columns in } $iconname {} iconname
    regsub {^List of } $iconname {} iconname
    wm iconname $tl $iconname

    ;##--- Put some buttons at the very bottom of the window
    frame $tl.barea

    ;##- "Save as..." button
    button $tl.barea.save -text "Save as..." \
	    -command [selsub {
		set saveFile [TableSaveDialog $tl.st $filename]
		TableSave $tl.st $filename $saveFile
		if {$saveFile != "" && $tableSaveType == "source" \
			&& [winfo exists $tl.status.filename] } {
		    $tl.status.filename configure -state normal
		    $tl.status.filename delete 0 end
		    $tl.status.filename insert end $saveFile
		    $tl.status.filename configure -state $::entrydis
		}
		unset saveFile
	    } tl filename ]

    ;##- If the filename is blank, disable the "Save as..." button
    if { $filename == "" } { $tl.barea.save configure -state disabled }

    ;##- "Help" and "Close" buttons
    button $tl.barea.help -text "Help" -command ShowScrolledTableHelp
    button $tl.barea.close -text "Close" \
	    -command "if \[winfo exists ${tl}save\] {destroy ${tl}save};\
	    if \[winfo exists ${tl}Icon\] {destroy ${tl}Icon};\
	    destroy $tl"

    ;##- Lay out the buttons
    grid $tl.barea.save $tl.barea.help $tl.barea.close -padx 10 -sticky news
    pack $tl.barea -side bottom

    if { $tableName != "" } {
	;##--- Put cross-reference buttons at the bottom of the window
	SetupCrossrefs $tl $tableName
    }

    ;##--- Print some status information at the bottom of the window
    frame $tl.status

    ;##- Show filename (if any)
    if { $filename != "" } {
	label $tl.status.filenamelabel -text "File:" -anchor w
	entry $tl.status.filename -relief flat -highlightcolor $::bgColor
	bind $tl.status.filename <Button> "focus %W"
	$tl.status.filename insert end $filename
	$tl.status.filename configure -state $::entrydis
    }

    ;##- Show query (if any)
    if { $queryText != "" } {
	label $tl.status.querylabel -text "Query was:" -anchor w
	entry $tl.status.query -relief flat -highlightcolor $::bgColor
	bind $tl.status.query <Button> "focus %W"
	$tl.status.query insert end $queryText
	$tl.status.query configure -state $::entrydis
	;##- Create a button to display the full query in a separate window
	button $tl.status.queryshow -text "Full" -pady 0 \
		-command "BigMessageBox -icon question -title {Query was:}\
		-message \[$tl.status.query get\]"
    }

    ;##- Lay out the filename and query (if any)
    if { $filename != "" } {
	grid $tl.status.filenamelabel $tl.status.filename - -sticky news
    }
    if { $queryText != "" } {
	grid $tl.status.querylabel $tl.status.query $tl.status.queryshow -sticky news
    }
    if { $filename != "" || $queryText != "" } {
	grid columnconfigure $tl.status 1 -weight 1
    }
    pack $tl.status -side bottom -fill x

    ;##- Now create the scrolledtable widget and insert the data into it
    set showrows 15
    if {$nRows < $showrows} {
	set showrows [expr {$nRows+1}]
    }

    scrolledtable::scrolledtable $tl.st init -width 80 -height $showrows
    pack $tl.st -side top -fill both -expand true
    foreach colname $colNames var $colValueVars {
	if {$nRows >= 50} {
###	    UpdateStatus "Building table (column $colname)..."
###	    update idletasks
	}
	scrolledtable::scrolledtable $tl.st column add $colname $var \
		-rowoffset $rowoffset
    }

    if {[winfo exists $tl.crossrefs]} {
	;##- Register each of the cross-reference buttons for automatic
	;##- enabling/disabling, BUT only if the displayed table
	;##- contains the information needed to perform the query.

	set columns [scrolledtable::scrolledtable $tl.st getcolnames]

	;##- (The [lrange ... 1 end] is to skip the first child
	;##- returned by the "winfo" command, which is the label.)
	foreach widget [lrange [winfo children $tl.crossrefs] 1 end] {

###	    puts "\n$widget is a [winfo class $widget]"
	    switch -- [winfo class $widget] {

		Button {
		    set cmd [$widget cget -command]
		    if { [CrossrefPossible $cmd $columns] } {
			;##- Register this widget
			scrolledtable::scrolledtable $tl.st rowbutton $widget
		    }
		}

		Menubutton {
		    set any_possible 0
		    ;##- Loop over items in the menu
		    for {set i 0} {$i <= [$widget.menu index end]} {incr i} {
			set cmd [$widget.menu entrycget $i -command]
			if { [CrossrefPossible $cmd $columns] } {
			    set any_possible 1
			} else {
			    $widget.menu entryconfigure $i -state disabled
			}
		    }
		    ;##- If a cross-ref is possible for ANY item,
		    ;##- then register the menubutton for enabling
		    if { $any_possible } {
			;##- Register this widget
			scrolledtable::scrolledtable $tl.st rowbutton $widget
		    }
		}

	    }
	}
    }

    if { ! [winfo exists $tl] } { return "" }

    ;##- If appropriate, set up a button to query for more from same table
    if { $queryText != "" } {
	SetupNextQ $tl $queryText
    }

    if { $tableName != "" } {
	;##- Set up actions when a user clicks on a value with the
	;##- middle or right mouse button.
	SetupActions $tl $tableName
    }

    ;##- Set up a binding so that double-clicking on a row number
    ;##- displays the row in a name-value window.  (This is in
    ;##- addition to any other binding, thanks to the "+" below.)
    if { ! [regsub {^Entries } $title {Selected entry } temptitle] } {
	set temptitle "Selected row display"
    }
    bind $tl.st.rownums <Double-Button-1> [selsub {+
	DisplayNamevalue {$temptitle} \
		[scrolledtable::scrolledtable $tl.st getcolnames] \
		[scrolledtable::scrolledtable $tl.st getrow sel]
	break
    } tl temptitle ]

    if { $::winIcons && ! [string is space $tl] } {
	;##- Update the icon
	if {[winfo ismapped ${tl}Icon]} {

	    ;##- Put a green border around the job icon
	    ${tl}Icon config -highlightcolor green -highlightbackground green
	    update idletasks
	    if { ! [winfo exists ${tl}Icon] } { return $tl }

	    ;##- Set up a binding to change the icon again when the table
	    ;##- window is deiconified
	    bind ${tl}Icon <Unmap> \
		    "+ ${tl}Icon config -highlightthickness 0;\
		    ${tl}Icon.bitmap config -image tableIcon;\
		    bind ${tl}Icon <Unmap> {}"

	    ;##- Ring the terminal bell
	    bell

	} else {
	    ${tl}Icon config -highlightthickness 0
	    ${tl}Icon.bitmap config -image tableIcon
	}
    }

    return $tl
}


##=========================================================================
## Name: DisplayNamevalue
##
## Description:
##   Routine to create a new window and display a set of name/value pairs,
##   suitable for presenting a single database entry in an easily readable
##   fashion.
##   Returns the Tk pathname of the toplevel widget created to display the
##   results.
## 
## Parameters:
##   title -- title to display above list
##   colnames -- list of column names
##   vallist -- list of values
##   tl -- Optional existing toplevel in which to build table
##
## Usage:
##   DisplayNamevalue title colnames vallist ?-toplevel tl?
##
## Comments:
##   Uses a text widget.  Column names appear in blue.
##   Returns the empty string if no toplevel was created for some reason.

proc DisplayNamevalue { title colnames vallist args } {

    ;##- If there is no data, just return
    if {[llength $vallist] == 0} { return "" }

    ;##- Set default values of optional arguments
    set tl ""

    ;##- Parse optional arguments
    foreach { opt optval } $args {
	switch -- $opt {
	    -toplevel { set tl $optval }
	}
    }

    ;##- Create a new window to display the table
    if {[string is space $tl]} {
	set tl [NewToplevel]

	if {$::winIcons} {
	    ;##- Also create an icon for this window
	    NewToplevel ${tl}Icon -icon -width 48 -height 48 \
		    -highlightthickness 0
	    label ${tl}Icon.bitmap -image tableIcon
	    pack ${tl}Icon.bitmap -side top -fill x
	    wm iconwindow $tl ${tl}Icon
	}

    } else {
	foreach widget [winfo children $tl] { destroy $widget }
    }

    ;##- Set the window title
    wm title $tl $title
    wm iconname $tl $title

    set msgwidth [expr {50*$scrolledtable::charwidth}]    ;##- Width in pixels
    message $tl.msg -justify center -width $msgwidth -text $title
    pack $tl.msg -side top

    ;##- Put a Close button at the bottom of the window
    frame $tl.barea
    button $tl.barea.close -text "Close" \
	    -command "if \[winfo exists ${tl}save\] {destroy ${tl}save};\
	    if \[winfo exists ${tl}Icon\] {destroy ${tl}Icon};\
	    destroy $tl"
    grid $tl.barea.close -padx 10 -sticky news
    pack $tl.barea -side bottom

    ;##- Now create a scrolled text area and insert the data into it
    frame $tl.list

    scrollbar $tl.list.yscroll -orient vertical \
	    -command "$tl.list.text yview"

    #-- Figure out tab positions, in pixels
    set tabstop1 [expr {19*$scrolledtable::charwidth}]
    set tabstop2 [expr {20*$scrolledtable::charwidth}]

    text $tl.list.text -height 20 -width 70 -setgrid true \
	    -yscrollcommand "$tl.list.yscroll set" \
	    -wrap word -tabs "$tabstop1 right $tabstop2 left"
    bind $tl.list.text <Button> "focus %W"
    $tl.list.text tag configure wrapindent -lmargin2 $tabstop2
    $tl.list.text tag configure colnametag -foreground blue

    foreach colname $colnames val $vallist {
	$tl.list.text insert end "\t$colname:" colnametag "\t$val\n"
    }
    ;##- Remove the final newline
    $tl.list.text delete "end -1 char" end

    ;##- Tag the whole text to indent wrapped lines
    $tl.list.text tag add wrapindent 1.0 end
    ;##- Prevent the user from modifying the text
    $tl.list.text configure -state disabled

    ;##- Adjust the height of the text widget if there is little data
    set nlines [expr {int([$tl.list.text index end])}]
    $tl.list.text configure -height $nlines

    ;##- Lay out the widgets
    grid $tl.list.text $tl.list.yscroll -sticky news
    grid rowconfigure $tl.list 0 -weight 1
    grid columnconfigure $tl.list 0 -weight 1
    pack $tl.list -side top -fill both -expand true

    if { $::winIcons && ! [string is space $tl] } {
	;##- Update the icon
	if {[winfo ismapped ${tl}Icon]} {

	    ;##- Put a green border around the job icon
	    ${tl}Icon config -highlightcolor green -highlightbackground green
	    update idletasks
	    if { ! [winfo exists ${tl}Icon] } { return $tl }

	    ;##- Set up a binding to change the icon again when the table
	    ;##- window is deiconified
	    bind ${tl}Icon <Unmap> \
		    "+ ${tl}Icon config -highlightthickness 0;\
		    ${tl}Icon.bitmap config -image tableIcon;\
		    bind ${tl}Icon <Unmap> {}"

	    ;##- Ring the terminal bell
	    bell

	} else {
	    ${tl}Icon config -highlightthickness 0
	    ${tl}Icon.bitmap config -image tableIcon
	}
    }

    return $tl
}


##=========================================================================
## Name: DisplayListbox
##
## Description:
##   Routine to create a new window and display a list in a scrolled listbox.
##   Returns the Tk pathname of the toplevel widget created to display the
##   results.
## 
## Parameters:
##   title -- window title
##   label -- label to appear above the list
##   vallist -- list of values
##   filename -- Optional (input) filename; displayed below table, and used to
##                    construct the default name for saving the table contents
##   tl -- Optional existing toplevel in which to build table
##
## Usage:
##   DisplayListbox title label vallist ?-file filename? ?-toplevel tl?
##
## Comments:
##   Returns the empty string if no toplevel was created for some reason.

proc DisplayListbox { title label vallist args } {

    ;##- Set default values of optional arguments
    set filename ""
    set tl ""

    ;##- Parse optional arguments
    foreach { opt optval } $args {
	switch -- $opt {
	    -file { set filename $optval }
	    -toplevel { set tl $optval }
	}
    }

    ;##- Map "(unknown)" to "" for the optional arguments
    if { $filename == "(unknown)" } { set filename "" }

    ;##- Create a new window to display the table
    if {[string is space $tl]} {
	set tl [NewToplevel]

	if {$::winIcons} {
	    ;##- Also create an icon for this window
	    NewToplevel ${tl}Icon -icon -width 48 -height 48 \
		    -highlightthickness 0
	    label ${tl}Icon.bitmap -image listIcon
	    pack ${tl}Icon.bitmap -side top -fill x
	    wm iconwindow $tl ${tl}Icon
	}

    } else {
	foreach widget [winfo children $tl] { destroy $widget }
    }

    ;##- Set the window title
    wm title $tl $title
    ;##- Set the icon name too
    set iconname $title
    regsub {^Values of } $iconname {} iconname
    regsub {^Columns in } $iconname {} iconname
    wm iconname $tl $iconname

    ;##--- Put a message at the top of the window

    message $tl.msg -justify center -aspect 10000 -text $label
    pack $tl.msg -side top

    ;##--- Put Save and Close buttons at the bottom of the window
    frame $tl.barea

    ;##- "Save as..." button
    button $tl.barea.save -text "Save as..." \
	    -command [selsub {
		set saveFile [TableSaveDialog $tl.st $filename]
		TableSave $tl.st $filename $saveFile
		unset saveFile
	    } tl filename ]

    ;##- If the filename is blank, disable the "Save as..." button
    if { $filename == "" } { $tl.barea.save configure -state disabled }

    button $tl.barea.close -text "Close" \
	    -command "if \[winfo exists ${tl}save\] {destroy ${tl}save};\
	    if \[winfo exists ${tl}Icon\] {destroy ${tl}Icon};\
	    destroy $tl"
		
    ;##- For now, leave off the "Save as..." button
###    grid $tl.barea.save $tl.barea.close -padx 10 -sticky news
    grid $tl.barea.close -padx 10 -sticky news
    pack $tl.barea -side bottom

    ;##- Now create a scrolled listbox and insert the list into it
    frame $tl.list

    scrollbar $tl.list.yscroll -orient vertical -command "$tl.list.lb yview"

    set showrows 15
    set nRows [llength $vallist]
    if {$nRows < $showrows} {
	set showrows [expr {$nRows+1}]
    }

    listbox $tl.list.lb -height $showrows -setgrid true \
	    -yscrollcommand "$tl.list.yscroll set" -setgrid true

    eval "$tl.list.lb insert end $vallist"

    grid $tl.list.lb $tl.list.yscroll -sticky news
    grid rowconfigure $tl.list 0 -weight 1
    grid columnconfigure $tl.list 0 -weight 1
    pack $tl.list -side top -fill both -expand true

    if { $::winIcons && ! [string is space $tl] } {
	;##- Update the icon
	if {[winfo ismapped ${tl}Icon]} {

	    ;##- Put a green border around the job icon
	    ${tl}Icon config -highlightcolor green -highlightbackground green
	    update idletasks
	    if { ! [winfo exists ${tl}Icon] } { return $tl }

	    ;##- Set up a binding to change the icon again when the list
	    ;##- window is deiconified
	    bind ${tl}Icon <Unmap> \
		    "+ ${tl}Icon config -highlightthickness 0;\
		    ${tl}Icon.bitmap config -image listIcon;\
		    bind ${tl}Icon <Unmap> {}"

	    ;##- Ring the terminal bell
	    bell

	} else {
	    ${tl}Icon config -highlightthickness 0
	    ${tl}Icon.bitmap config -image listIcon
	}
    }

    return $tl
}


##=========================================================================
## Name: TableSaveDialog
##
## Description:
##   Gives the user a dialog to determine how the table information is
##   to be formatted, then prompts for the output filename.  Does not actually
##   save the information; that is done by TableSave.
## 
## Parameters:
##   st -- name of scrolledtable pseudo-widget
##   filename -- original filename (or URL)
##
## Usage:
##   TableSaveDialog st filename
##
## Comments:
##   Formatting options are common to all save dialogs.
##   It would be nice to have just one dialog which handled both the
##   formatting options and selection of the output filename, but the
##   tk_getSaveFile doesn't provide a way to put other stuff in the
##   same toplevel.

proc TableSaveDialog { st filename } {
###    puts "In TableSaveDialog, st is $st"

    ;##- Create a new toplevel for the dialog box, unless it already exists
    set tabletl [winfo toplevel $st]
    set tl ${tabletl}save
    if {[winfo exists $tl]} {
	switch -- [wm state $tl] {
	    normal { raise $tl; focus $tl }
	    iconic { wm deiconify $tl; focus $tl }
	}
	return ""
    } else {
	NewToplevel $tl
	wm title $tl "Save table data -- formatting"
	bind $tabletl <Destroy> "+if \[winfo exists $tl\] {destroy $tl}"
    }

    ;##- Access global saving options
    global tableSaveType tableSaveTextFormat \
	    tableSaveCommaReplace tableSaveSpaceReplace \
	    tableSaveKeepColName tableSaveKeepRowNum tableSaveKeepTruncBase

    ;##- Set default options if they have not been set
    if { ! [info exists tableSaveType] } {
	set tableSaveType "source"
	set tableSaveTextFormat "comma"
	set tableSaveCommaReplace ";"
	set tableSaveSpaceReplace "_"
	set tableSaveKeepColName "no"
	set tableSaveKeepRowNum "yes"
	set tableSaveKeepTruncBase "no"
    }

    ;##- Declare a global variable specific to this dialog
    set tlbase [string range $tl 1 end]
    global choice$tlbase

    ;##---------- Now set up all the widgets!

    ;##- First put buttons at bottom
    frame $tl.barea
    button $tl.barea.continue -text "Continue to filename selection" \
	    -command "set choice$tlbase continue; destroy $tl" \
	    -default active
    button $tl.barea.cancel -text "Cancel" \
	    -command "set choice$tlbase cancel; destroy $tl"
    grid $tl.barea.continue $tl.barea.cancel -padx 10 -pady 5 -sticky news
    pack $tl.barea -side bottom -fill x

    ;##- Bind the Return key to the Continue button
    bind $tl <Return> "$tl.barea.continue invoke"

    ;##- Add some padding above buttons
    frame $tl.padbottom -height 2 -bg black
    pack $tl.padbottom -side bottom -fill x -pady 10

    ;##- Main options section

    frame $tl.savetype
    radiobutton $tl.savetype.source \
	    -text "Save whole table in original format ($::dbreturnformat)" \
	    -pady 0 -variable tableSaveType -value "source" \
	    -command [subbut {
		    foreach tmp {$tl.format.comma.button\
			    $tl.format.space.button\
			    $tl.format.tab $tl.format.align\
			    $tl.colname.yes $tl.colname.no\
			    $tl.rownum.yes $tl.rownum.no\
			    $tl.trunc.yes $tl.trunc.no} \
			    {$tmp config -state disabled}
		    foreach tmp {$tl.textnote $tl.format.head\
			    $tl.format.comma.msg $tl.format.comma.replace\
			    $tl.format.comma.msg2 $tl.format.space.msg\
			    $tl.format.space.replace $tl.format.space.msg2\
			    $tl.format.space.button $tl.format.tab\
			    $tl.colname.head $tl.rownum.head $tl.trunc.head} \
			    {$tmp config -fg gray60}
		} tmp ]
    frame $tl.savetype.rule -height 2 -bg black
    frame $tl.savetype.pad -height 10
    radiobutton $tl.savetype.text -text "Save displayed data as text" -pady 0 \
	    -variable tableSaveType -value "text" \
	    -command [subbut {
		    foreach tmp {$tl.format.comma.button\
			    $tl.format.space.button\
			    $tl.format.tab $tl.format.align\
			    $tl.colname.yes $tl.colname.no\
			    $tl.rownum.yes $tl.rownum.no\
			    $tl.trunc.yes $tl.trunc.no} \
			    {$tmp config -state normal}
		    foreach tmp {$tl.textnote $tl.format.head\
			    $tl.format.comma.msg $tl.format.comma.replace\
			    $tl.format.comma.msg2 $tl.format.space.msg\
			    $tl.format.space.replace $tl.format.space.msg2\
			    $tl.format.space.button $tl.format.tab\
			    $tl.colname.head $tl.rownum.head $tl.trunc.head} \
			    {$tmp config -fg black}
		} tmp ]

    pack $tl.savetype.source -side top -anchor w -pady 10
    pack $tl.savetype.rule -side top -fill x -expand true
    pack $tl.savetype.pad -side top -fill x -expand true
    pack $tl.savetype.text -side top -anchor w

    pack $tl.savetype -side top -fill x -expand true

    ;##- Put empty frames along the sides, to indent the rest
    frame $tl.padleft -width 30
    frame $tl.padright -width 30
    pack $tl.padleft -side left
    pack $tl.padright -side right

    ;##- Now put in stuff under the "save as text" section
    message $tl.textnote -justify left -aspect 1000 \
	    -text "You may hide/show columns and/or adjust their\
	    widths to control what will be saved."
    pack $tl.textnote -side top -anchor w -fill x -expand true

    ;##---- "Formatting" section
    frame $tl.format
###    frame $tl.format.padtop -height 5
    message $tl.format.head -justify left -aspect 10000 \
	    -text "Text formatting:"
    frame $tl.format.padleft -width 20

    frame $tl.format.comma
    radiobutton $tl.format.comma.button -text "Comma-delimited" -pady 0 \
	    -variable tableSaveTextFormat -value "comma"
    message $tl.format.comma.msg -aspect 10000 \
	    -text " (replace any embedded commas with"
    entry $tl.format.comma.replace \
	    -textvariable tableSaveCommaReplace -width 2
    message $tl.format.comma.msg2 -aspect 10000 -text ")"
    pack $tl.format.comma.button -side left
    pack $tl.format.comma.msg -side left
    pack $tl.format.comma.replace -side left
    pack $tl.format.comma.msg2 -side left

    frame $tl.format.space
    radiobutton $tl.format.space.button -text "Space-delimited" -pady 0 \
	    -variable tableSaveTextFormat -value "space"
    message $tl.format.space.msg -aspect 10000 \
	    -text " (replace any embedded spaces with"
    entry $tl.format.space.replace \
	    -textvariable tableSaveSpaceReplace -width 2
    message $tl.format.space.msg2 -aspect 10000 -text ")"
    pack $tl.format.space.button -side left
    pack $tl.format.space.msg -side left
    pack $tl.format.space.replace -side left
    pack $tl.format.space.msg2 -side left

    radiobutton $tl.format.tab -text "Tab-delimited" -pady 0 \
	    -variable tableSaveTextFormat -value "tab"

    radiobutton $tl.format.align \
	    -text "Use spaces to keep columns aligned as on screen" -pady 0 \
	    -variable tableSaveTextFormat -value "align"

###    pack $tl.format.padtop -side top -fill x -expand true
    pack $tl.format.head -side top -anchor w
    pack $tl.format.padleft -side left -fill y
    pack $tl.format.comma -side top -anchor w
    pack $tl.format.space -side top -anchor w
    pack $tl.format.tab -side top -anchor w
    pack $tl.format.align -side top -anchor w
    
    pack $tl.format -side top -fill x -expand true

    ;##---- "Column names" section
    frame $tl.colname
###    frame $tl.colname.padtop -height 5
    message $tl.colname.head -justify left -aspect 10000 \
	    -text "Column names:"
    frame $tl.colname.padleft -width 20

    radiobutton $tl.colname.yes -text "Include in output" -pady 0 \
	    -variable tableSaveKeepColName -value "yes"
    radiobutton $tl.colname.no -text "Do not include" -pady 0 \
	    -variable tableSaveKeepColName -value "no"

###    pack $tl.colname.padtop -side top -fill x -expand true
    pack $tl.colname.head -side top -anchor w
    pack $tl.colname.padleft -side left -fill y
    pack $tl.colname.yes -side top -anchor w
    pack $tl.colname.no -side top -anchor w

    pack $tl.colname -side top -fill x -expand true

    ;##---- "Row numbers" section
    frame $tl.rownum
###    frame $tl.rownum.padtop -height 5
    message $tl.rownum.head -justify left -aspect 10000 \
	    -text "Row numbers:"
    frame $tl.rownum.padleft -width 20

    radiobutton $tl.rownum.yes -text "Include in output" -pady 0 \
	    -variable tableSaveKeepRowNum -value "yes"
    radiobutton $tl.rownum.no -text "Do not include" -pady 0 \
	    -variable tableSaveKeepRowNum -value "no"

###    pack $tl.rownum.padtop -side top -fill x -expand true
    pack $tl.rownum.head -side top -anchor w
    pack $tl.rownum.padleft -side left -fill y
    pack $tl.rownum.yes -side top -anchor w
    pack $tl.rownum.no -side top -anchor w

    pack $tl.rownum -side top -fill x -expand true

    ;##---- "Truncation marks" section
    frame $tl.trunc
###    frame $tl.trunc.padtop -height 5
    message $tl.trunc.head -justify left -aspect 10000 \
	    -text "Truncation marks (red plus signs):"
    frame $tl.trunc.padleft -width 20

    radiobutton $tl.trunc.yes -text "Include in output" -pady 0 \
	    -variable tableSaveKeepTruncBase -value "yes"
    radiobutton $tl.trunc.no -text "Do not include" -pady 0 \
	    -variable tableSaveKeepTruncBase -value "no"

###    pack $tl.trunc.padtop -side top -fill x -expand true
    pack $tl.trunc.head -side top -anchor w
    pack $tl.trunc.padleft -side left -fill y
    pack $tl.trunc.yes -side top -anchor w
    pack $tl.trunc.no -side top -anchor w

    pack $tl.trunc -side top -fill x -expand true

    ;##- Invoke the current savetype radiobutton to trigger its command
    $tl.savetype.$tableSaveType invoke

    ;##---------- Wait for user to press one of the buttons
    vwait choice$tlbase

    if { ! [info exists choice$tlbase] } { return "" }
    set choice [set choice$tlbase]
    unset choice$tlbase
    if { $choice == "cancel" } { return "" }

    ;##- If the user has closed the original window, just return
    if { ! [winfo exists $tabletl] } { return "" }

    ;##- Construct the default file name in which to save the file
    ;##- Normally this just involves taking the tail end of the URL,
    ;##- or replacing "guildtemp" by "guild"
    if { $filename != "" } {
	if { [string match http://* $filename] } {
	    set defSaveFile [file tail $filename]
	} elseif { ! [regsub -- {guildtemp} $filename {guild} defSaveFile] } {
	    ;##- Didn't find "guildtemp", so just append ".copy"
	    set defSaveFile "$filename.copy"
	}
	;##- If saving as text, change the default extension to ".txt"
	if { $tableSaveType ==  "text" } {
	    regsub {\.xml$} $defSaveFile {.txt} defSaveFile
	}
    } else {
	set defSaveFile ""
    }

    ;##- Get filename to save to
    wm deiconify $tabletl
    set saveFile [tk_getSaveFile -parent $tabletl \
	    -initialfile $defSaveFile -title "Save Table Contents"]
    set saveFile [string trim $saveFile]
    if {[string is space $saveFile]} { return "" }
    return $saveFile
}


##=========================================================================
## Name: TableSave
##
## Description:
##   Routine which actually saves table information, based on formatting
##   options stored in global variables.
## 
## Parameters:
##   st -- name of scrolledtable pseudo-widget
##   filename -- original filename (or URL)
##   outfile -- output filename
##
## Usage:
##   TableSave st filename outfile
##
## Comments:
##   If outfile is blank, just returns.

proc TableSave { st filename outfile } {
###    puts "In TableSave, st is $st"

    if {[string is space $outfile]} { return "" }
    if { ! [winfo exists $st] } { return "" }

    ;##- Access global saving options
    global tableSaveType tableSaveTextFormat \
	    tableSaveCommaReplace tableSaveSpaceReplace \
	    tableSaveKeepColName tableSaveKeepRowNum tableSaveKeepTruncBase

    ;##- Save-as-source is simple, so handle this case and return
    if { $tableSaveType == "source" } {
	if { [string match http://* $filename] } {
	    if { [catch {open $outfile w} fid] } {
		set ignore [ tk_messageBox -type ok -icon error \
			-title "Error saving table" \
			-message "Error saving table as $outfile:\n$errmsg" ]
		return ""
	    } else {
		;##- Access the memory image of the URL contents
		upvar #0 $filename contents	
		puts $fid $contents
		close $fid
	    }	    
	} elseif {[catch {file copy -force $filename $outfile} errmsg]} {
	    set ignore [ tk_messageBox -type ok -icon error \
		    -title "Error saving table" \
		    -message "Error saving table as $outfile:\n$errmsg" ]
	    return ""
	}
	return $outfile
    }

    ;##- Now handle the other cases

    if {[catch {open $outfile w} fid]} {
	set ignore [ tk_messageBox -type ok -icon error \
		-title "Error opening file"\
		-message "Error opening file $outfile for output: $fid" ]
	return ""
    }

    switch -- $tableSaveTextFormat {

	comma -
	space -
	tab {
	    switch -- $tableSaveTextFormat {
		comma {
		    set map [list \t , , $tableSaveCommaReplace]
		    set delim ","
		}
		space {
		    set map [list \t " " " " $tableSaveSpaceReplace]
		    set delim " "
		}
		tab {
		    set map [list \t \t]
		    set delim "\t"
		}
	    }

	    switch $tableSaveKeepTruncBase \
		    yes { set posred 1; set negred -1 } \
		    no  { set posred 2; set negred -2 }

	    set colwidths [scrolledtable::scrolledtable $st getcolwidth]
	    ;##- Append a value to handle the tab at the end of the line
	    lappend colwidths 0

	    ;##- If column names are desired, print them now
	    if { $tableSaveKeepColName == "yes" } {
		set sep ""
		set colnames [scrolledtable::scrolledtable $st getcolnames]
		if { $tableSaveKeepRowNum == "yes"} {
		    puts -nonewline $fid "ROW"
		    set sep $delim
		}
		set icol -1
		foreach colname $colnames {
		    incr icol
		    if {[lindex $colwidths $icol] > -1} {
			puts -nonewline $fid "$sep$colname"
			set sep $delim
		    }
		}
		puts $fid ""
	    }

	    if { $tableSaveKeepRowNum == "yes" } {
		set keeprownum 1
		set irow 1
		set sep "$irow$delim"
	    } else {
		set keeprownum 0
		set sep ""
	    }
	    set line ""

	    set icol -1
	    set active 2

	    foreach {key value index} [$st.text dump -text -tag 0.0 end] {
###		puts "$key $value"
		switch $key {
		    text {
			if { $active > 0 } {
			    if {[string index $value 0] == "\t"} {
				incr icol
				if {[string equal $value "\t"]} {
				    if {[lindex $colwidths $icol] == -1} {
					continue
				    }
				}
			    }

			    append line [string map $map $value]
			    if {[regexp "\n" $value]} {
				;##- Trim off the initial and final delims
				puts -nonewline $fid \
					"${sep}[string range $line 1 end-2]\n"
				;##- Get ready for the next row (if any)
				if {$keeprownum} {
				    incr irow
				    set sep "$irow$delim"
				}
				set line ""
				set icol -1
			    }
			}
		    }
		    tagon {
			switch $value \
				hidden { incr active -2 } \
				redtext { incr active $negred }
		    }
		    tagoff {
			switch $value \
				hidden { incr active 2 } \
				redtext { incr active $posred }
		    }
		}
	    }
	}

	align {

	    switch $tableSaveKeepTruncBase \
		    yes { set posred 1; set negred -1 } \
		    no  { set posred 2; set negred -2 }

	    set colwidths [scrolledtable::scrolledtable $st getcolwidth]
	    ;##- Append a value to handle the tab at the end of the line
	    lappend colwidths 0

	    ;##- If column names are desired, print them now
	    if { $tableSaveKeepColName == "yes" } {
		set colnames [scrolledtable::scrolledtable $st getcolnames]
		set line ""
		if { $tableSaveKeepRowNum == "yes" } {
		    append line " ROWNUM "
		}
		set icol -1
		foreach colname $colnames {
		    incr icol
		    set width [lindex $colwidths $icol]
		    if {$width > -1} {
			set textwidth [string length $colname]
			set trunctext \
				[string range $colname 0 [expr {$width-1}]]
			if { $textwidth <= $width || \
				$tableSaveKeepTruncBase == "no" } {
			    append line " [format "%-${width}s" $trunctext] "
			} else {
			    append line " $trunctext+"
			}
		    }
		}
		puts $fid $line
	    }

	    if { $tableSaveKeepRowNum == "yes" } {
		set keeprownum 1
		set irow 1
		set line [format "%7d " $irow]
	    } else {
		set keeprownum 0
		set line ""
	    }

	    set icol -1
	    set active 2

	    set textrep 0
	    foreach {key value index} [$st.text dump -text -tag 0.0 end] {
###		puts "$key $value"
		switch $key {
		    text {
			if { $active > 0 } {
			    if {[string index $value 0] == "\t"} {
				incr icol
				set width [lindex $colwidths $icol]
				if {$width == -1} { continue }
			    }

			    set tempval [string map {"\t" "" } $value]

			    ;##- If previous key was also text, combine with it
			    if { $textrep } {
				set line [string range $line \
					0 end-[expr {$lastwidth+2}]]
				set tempval "${lastvalue}$tempval"
			    }

			    if { [string equal $value "+"] } {
				set line "[string range $line 0 end-1]+"
			    } elseif { $tempval != "\n" } {
				append line " [format "%-${width}s" $tempval] "
				set lastvalue $tempval
				set lastwidth $width
			    }

			    set textrep 1

			    if {[regexp "\n" $value]} {
				puts $fid $line
				;##- Get ready for the next row (if any)
				if {$keeprownum} {
				    incr irow
				    set line [format "%7d " $irow]
				} else {
				    set line ""
				}
				set icol -1
				set textrep 0
			    }
			}
		    }
		    tagon {
			switch $value \
				hidden { incr active -2 } \
				redtext { incr active $negred }
			set textrep 0
		    }
		    tagoff {
			switch $value \
				hidden { incr active 2 } \
				redtext { incr active $posred }
			set textrep 0
		    }
		} ;##- End of switch
	    } ;##- End of foreach

	}

    }

    close $fid

    return $outfile
}


##=========================================================================
## Name: SetupCrossrefs
##
## Description:
##   Table-specific code to set up the "Cross-ref" buttons and/or menubuttons
##   at the bottom of a scrolledtable display, depending on the table data
##   being displayed.
## 
## Parameters:
##   tl -- Tk pathname for toplevel widget of "build query" dialog
##   table -- database table name, used to determine what crossrefs are set up
##
## Usage:
##   SetupCrossrefs tl table
##
## Comments:
##   The created Cross-ref buttons are enabled whenever a row is selected.  In
##   most cases, these buttons do one of three things:
##    * Execute an SQL query which will match exactly one database entry,
##        and display the values for that entry in a "namevalue" window
##    * Execute an SQL query which may match multiple database entries, and
##        display a list of the entries in a "scrolledtable" window
##    * Pop up a "build query" dialog for a related table, with some of the
##        qualifiers preset to restrict the query to things matching the
##        selected row in the original table
## ;#ol
## The SQL query usually has the form:
##   select * from <related_table> where (var=<value of var in original table>)
## The StdCrQ proc is used to construct this type of query, to keep this
## routine more readable.  Note that when setting up a text comparison with
## StdCrQ, you have to put the current value in single quotes.  For example:
##   [StdCrQ summ_value frameset_group='<frameset_group>' start_time end_time]
## Of course, you can specify any query explicitly rather than using StdCrQ.

proc SetupCrossrefs { tl table } {
###    puts "In SetupCrossrefs for table $table"

    set table [string tolower $table]
    switch -- $table {

	syscat.tables {	;##- List of tables
	    AddCrossref button $tl "Describe table" -scrolledtable \
		    "SELECT\
		    colname,typename,length,codepage,default,nulls,remarks\
		    FROM syscat.columns\
		    WHERE tabname='<TABNAME>' AND tabschema='<TABSCHEMA>'\
		    ORDER BY colno"
	    AddCrossref button $tl "Create query dialog" \
		    -dialog "<TABNAME>"
	}

	zzusertag {
	    AddCrossref button $tl "List of LDAS jobs" -listbox \
		    "SELECT jobid from process where (process_id,creator_db)\
		    in (select distinct process_id,creator_db\
		    from process_params\
		    where param='-userTag' and value='<USER_TAG>')\
		    order by jobid"
	    AddCrossref button $tl "Processes..." \
		    -dialog "process" -preset "zzusertag=<USER_TAG>"
	}

	process {
	    AddCrossref button $tl "Parameters" -scrolledtable \
		    [StdCrQ process_params creator_db process_id]
	    AddCrossref button $tl "Filters" -scrolledtable \
		    [StdCrQ filter creator_db process_id]

	    set m [CrossrefMenubutton $tl "Framesets..."]
	    AddCrossref menuitem $m "Channel lists recorded" -scrolledtable \
		    [StdCrQ frameset_chanlist creator_db process_id]
	    AddCrossref menuitem $m "Frameset writing info" -scrolledtable \
		    [StdCrQ frameset_writer creator_db process_id]
	    AddCrossref menuitem $m "Framesets written..." \
		    -dialog frameset -preset creator_db,process_id

	    set m [CrossrefMenubutton $tl "Segments..."]
#-- The segment_definer table is not currently used
##	    AddCrossref menuitem $m "Segment defining info" -scrolledtable \
##		    [StdCrQ segment_definer creator_db process_id]
	    AddCrossref menuitem $m "Segments defined..." \
		    -dialog segment -preset creator_db,process_id

	    set m [CrossrefMenubutton $tl "Summary info..."]
	    AddCrossref menuitem $m "Search summary info" -namevalue \
		    [StdCrQ search_summary creator_db process_id]
	    AddCrossref menuitem $m "Search summary variables" -scrolledtable \
		    [StdCrQ search_summvars creator_db process_id]
	    AddCrossref menuitem $m "Scalar values..." \
		    -dialog summ_value -preset creator_db,process_id
	    AddCrossref menuitem $m "Channel statistics..." \
		    -dialog summ_statistics -preset creator_db,process_id
	    AddCrossref menuitem $m "Spectra..." \
		    -dialog summ_spectrum -preset creator_db,process_id
	    AddCrossref menuitem $m "MIME objects..." \
		    -dialog summ_mime -preset creator_db,process_id
	    AddCrossref menuitem $m "Comments..." \
		    -dialog summ_comment -preset creator_db,process_id

	    set m [CrossrefMenubutton $tl "Events..."]
	    AddCrossref menuitem $m "GDS triggers..." \
		    -dialog gds_trigger -preset creator_db,process_id
	    AddCrossref menuitem $m "single-interferometer inspirals..." \
		    -dialog sngl_inspiral -preset creator_db,process_id
	    AddCrossref menuitem $m "single-interferometer bursts..." \
		    -dialog sngl_burst -preset creator_db,process_id
	    AddCrossref menuitem $m "WaveBurst triggers..." \
		    -dialog waveburst -preset creator_db,process_id
	    AddCrossref menuitem $m "BlockNormal triggers..." \
		    -dialog sngl_block -preset creator_db,process_id
	    AddCrossref menuitem $m "single-interferometer ringdowns..." \
		    -dialog sngl_ringdown -preset creator_db,process_id
	    AddCrossref menuitem $m "single-interferometer unmodeled..." \
		    -dialog sngl_unmodeled -preset creator_db,process_id
	    AddCrossref menuitem $m "single-i directed periodic searches..."\
		    -dialog sngl_dperiodic -preset creator_db,process_id
	    AddCrossref menuitem $m "single-i event coincidences..." \
		    -dialog coinc_sngl -preset creator_db,process_id
	    AddCrossref menuitem $m "multi-interferometer inspirals..." \
		    -dialog multi_inspiral -preset creator_db,process_id
	    AddCrossref menuitem $m "multi-interferometer bursts..." \
		    -dialog multi_burst -preset creator_db,process_id
	    AddCrossref menuitem $m "externally-triggered search..." \
		    -dialog exttrig_search -preset creator_db,process_id
	}

	process_params {
	    AddCrossref button $tl "Process info" -namevalue \
		    [StdCrQ process creator_db process_id]
	}

	search_summary {
	    AddCrossref button $tl "Process info" -namevalue \
		    [StdCrQ process creator_db process_id]
	    AddCrossref button $tl "Search summary variables" -scrolledtable \
		    [StdCrQ search_summvars creator_db process_id]
	}

	search_summvars {
	    AddCrossref button $tl "Process info" -namevalue \
		    [StdCrQ process creator_db process_id]
	    AddCrossref button $tl "Search summary info" -namevalue \
		    [StdCrQ search_summary creator_db process_id]
	}

	filter {
	    set m [CrossrefMenubutton $tl "Process..."]
	    AddCrossref menuitem $m "Process info" -namevalue \
		    [StdCrQ process creator_db process_id]
	    AddCrossref menuitem $m "Process params" -scrolledtable \
		    [StdCrQ process_params creator_db process_id]

	    AddCrossref button $tl "Filter params" -scrolledtable \
		    [StdCrQ filter_params creator_db filter_id]

	    set m [CrossrefMenubutton $tl "Events..."]
	    AddCrossref menuitem $m "GDS triggers..." \
		    -dialog gds_trigger -preset creator_db,filter_id
	    AddCrossref menuitem $m "single-interferometer inspirals..." \
		    -dialog sngl_inspiral -preset creator_db,filter_id
	    AddCrossref menuitem $m "single-interferometer bursts..." \
		    -dialog sngl_burst -preset creator_db,filter_id
	    AddCrossref menuitem $m "WaveBurst triggers..." \
		    -dialog waveburst -preset creator_db,process_id
	    AddCrossref menuitem $m "BlockNormal triggers..." \
		    -dialog sngl_block -preset creator_db,process_id
	    AddCrossref menuitem $m "single-interferometer ringdowns..." \
		    -dialog sngl_ringdown -preset creator_db,filter_id
	    AddCrossref menuitem $m "single-interferometer unmodeled..." \
		    -dialog sngl_unmodeled -preset creator_db,filter_id
	    AddCrossref menuitem $m "single-i directed periodic searches..."\
		    -dialog sngl_dperiodic -preset creator_db,filter_id
	    AddCrossref menuitem $m "single-i event coincidences..." \
		    -dialog coinc_sngl -preset creator_db,filter_id
	    AddCrossref menuitem $m "multi-interferometer inspirals..." \
		    -dialog multi_inspiral -preset creator_db,filter_id
	    AddCrossref menuitem $m "multi-interferometer bursts..." \
		    -dialog multi_burst -preset creator_db,filter_id
	}

	filter_params {
	    AddCrossref button $tl "Filter info" -namevalue \
		    [StdCrQ filter creator_db filter_id]
	}

	frameset_chanlist {
	    set m [CrossrefMenubutton $tl "Process..."]
	    AddCrossref menuitem $m "Process info" -namevalue \
		    [StdCrQ process creator_db process_id]
	    AddCrossref menuitem $m "Process params" -scrolledtable \
		    [StdCrQ process_params creator_db process_id]

	    AddCrossref button $tl "Framesets..." -dialog frameset \
		    -preset chanlist_cdb=<creator_db>,chanlist_id
	}

	frameset_writer {
	    set m [CrossrefMenubutton $tl "Process..."]
	    AddCrossref menuitem $m "Process info" -namevalue \
		    [StdCrQ process creator_db process_id]
	    AddCrossref menuitem $m "Process params" -scrolledtable \
		    [StdCrQ process_params creator_db process_id]

	    AddCrossref button $tl "Framesets..." -dialog frameset -preset \
		    frameset_group,creator_db,process_id
	}

	frameset {
	    set m [CrossrefMenubutton $tl "Process..."]
	    AddCrossref menuitem $m "Process info" -namevalue \
		    [StdCrQ process creator_db process_id]
	    AddCrossref menuitem $m "Process params" -scrolledtable \
		    [StdCrQ process_params creator_db process_id]

	    ;##- Note single quotes are needed around <frameset_group> because
	    ;##- this is a text comparison
	    AddCrossref button $tl "Writing info" -namevalue \
		    [StdCrQ frameset_writer frameset_group='<frameset_group>' \
		    creator_db process_id]
	    AddCrossref button $tl "Channel list" -namevalue \
		    [StdCrQ frameset_chanlist creator_db=<chanlist_cdb> \
		    chanlist_id]
	    AddCrossref button $tl "Locations" -scrolledtable \
		    [StdCrQ frameset_loc name]

	    set m [CrossrefMenubutton $tl "Summary info..."]
	    AddCrossref menuitem $m "Scalar values" -scrolledtable \
		    [StdCrQ summ_value frameset_group='<frameset_group>' \
		    start_time end_time]
	    AddCrossref menuitem $m "Channel statistics" -scrolledtable \
		    [StdCrQ summ_statistics frameset_group='<frameset_group>' \
		    start_time end_time]
	    AddCrossref menuitem $m "Spectra" -scrolledtable \
		    [StdCrQ summ_spectrum frameset_group='<frameset_group>' \
		    start_time end_time]
	    AddCrossref menuitem $m "MIME objects" -scrolledtable \
		    [StdCrQ summ_mime frameset_group='<frameset_group>' \
		    start_time end_time]
	    AddCrossref menuitem $m "Comments" -scrolledtable \
		    [StdCrQ summ_comment frameset_group='<frameset_group>' \
		    start_time end_time]
	}

	frameset_loc {
	    AddCrossref button $tl "Frameset info" -namevalue \
		    [StdCrQ frameset name]
	}

	segment_definer {
	    set m [CrossrefMenubutton $tl "Process..."]
	    AddCrossref menuitem $m "Process info" -namevalue \
		    [StdCrQ process creator_db process_id]
	    AddCrossref menuitem $m "Process params" -scrolledtable \
		    [StdCrQ process_params creator_db process_id]

	    AddCrossref button $tl "Segments..." -dialog segment -preset \
		  segment_group,version,creator_db,process_id
	}

	segment {
	    set m [CrossrefMenubutton $tl "Process..."]
	    AddCrossref menuitem $m "Process info" -namevalue \
		    [StdCrQ process creator_db process_id]
	    AddCrossref menuitem $m "Process params" -scrolledtable \
		    [StdCrQ process_params creator_db process_id]

#-- The segment_definer table is not currently used
##	    AddCrossref button $tl "Defining info" -namevalue \
##		    [StdCrQ segment_definer segment_group='<segment_group>' \
##		    version creator_db process_id]

	    set m [CrossrefMenubutton $tl "Summary info..."]
	    AddCrossref menuitem $m "Scalar values" -scrolledtable \
		    [StdCrQ summ_value segment_group='<segment_group>' \
		    version start_time end_time]
	    AddCrossref menuitem $m "Channel statistics" -scrolledtable \
		    [StdCrQ summ_statistics segment_group='<segment_group>' \
		    version start_time end_time]
	    AddCrossref menuitem $m "Spectra" -scrolledtable \
		    [StdCrQ summ_spectrum segment_group='<segment_group>' \
		    version start_time end_time]
	    AddCrossref menuitem $m "MIME objects" -scrolledtable \
		    [StdCrQ summ_mime segment_group='<segment_group>' \
		    version start_time end_time]
	    AddCrossref menuitem $m "Comments" -scrolledtable \
		    [StdCrQ summ_comment segment_group='<segment_group>' \
		    version start_time end_time]
	}

	summ_value -
	summ_statistics -
	summ_spectrum -
	summ_csd -
	summ_mime -
	summ_comment {
	    set m [CrossrefMenubutton $tl "Process..."]
	    AddCrossref menuitem $m "Process info" -namevalue \
		    [StdCrQ process creator_db process_id]
	    AddCrossref menuitem $m "Process params" -scrolledtable \
		    [StdCrQ process_params creator_db process_id]

	    AddCrossref button $tl "Frameset info" -namevalue \
		    [StdCrQ frameset frameset_group='<frameset_group>' \
		    start_time end_time]
	    AddCrossref button $tl "Segment info" -namevalue \
		    [StdCrQ segment segment_group='<segment_group>' \
		    version start_time end_time]

	    if { $table == "summ_spectrum" } {
		AddCrossref button $tl "Full record" -scrolledtable \
			"select * from $table\
			where process_id=<PROCESS_ID>\
			and creator_db=<CREATOR_DB>\
			and start_time=<START_TIME>\
			and start_time_ns=<START_TIME_NS>\
			and end_time=<END_TIME>\
			and end_time_ns=<END_TIME_NS>\
			and start_frequency=<START_FREQUENCY>\
			and delta_frequency=<DELTA_FREQUENCY>\
			and channel='<CHANNEL>'"
	    } elseif { $table == "summ_csd" } {
		AddCrossref button $tl "Full record" -scrolledtable \
			"select * from $table\
			where process_id=<PROCESS_ID>\
			and creator_db=<CREATOR_DB>\
			and start_time=<START_TIME>\
			and start_time_ns=<START_TIME_NS>\
			and end_time=<END_TIME>\
			and end_time_ns=<END_TIME_NS>\
			and start_frequency=<START_FREQUENCY>\
			and delta_frequency=<DELTA_FREQUENCY>\
			and channel1='<CHANNEL1>'\
			and channel2='<CHANNEL2>'"
	    } elseif { $table == "summ_mime" } {
		AddCrossref button $tl "Full record" -scrolledtable \
			"select * from $table\
			where summ_mime_id=<SUMM_MIME_ID>\
			and creator_db=<CREATOR_DB>"
	    }
	}

	gds_trigger -
	sngl_inspiral -
	sngl_burst -
	sngl_ringdown {
	    set m [CrossrefMenubutton $tl "Process..."]
	    AddCrossref menuitem $m "Process info" -namevalue \
		    [StdCrQ process creator_db process_id]
	    AddCrossref menuitem $m "Process params" -scrolledtable \
		    [StdCrQ process_params creator_db process_id]

	    set m [CrossrefMenubutton $tl "Filter..."]
	    AddCrossref menuitem $m "Filter info" -namevalue \
		    [StdCrQ filter creator_db filter_id]
	    AddCrossref menuitem $m "Filter params" -namevalue \
		    [StdCrQ filter_params creator_db filter_id]

	    set m [CrossrefMenubutton $tl "Event info..."]
	    AddCrossref menuitem $m "Data source" -scrolledtable \
		    [StdCrQ sngl_datasource creator_db event_id]
	    AddCrossref menuitem $m "Transformed data" -scrolledtable \
		    [StdCrQ sngl_transdata creator_db event_id]
	    AddCrossref menuitem $m "MIME objects" -scrolledtable \
		    [StdCrQ sngl_mime creator_db event_id]

	    switch -- $table {
		gds_trigger { set nik gdstrig }
		sngl_inspiral { set nik inspiral }
		sngl_burst { set nik burst }
		sngl_ringdown { set nik ringdown }
	    }

	    AddCrossref button $tl "Coincidences" -scrolledtable \
		    "SELECT * FROM coinc_sngl WHERE (\
		    h1_${nik}_cdb=<creator_db> AND h1_${nik}_id=<event_id>\
		    ) OR (\
		    h2_${nik}_cdb=<creator_db> AND h2_${nik}_id=<event_id>\
		    ) OR (\
		    l1_${nik}_cdb=<creator_db> AND l1_${nik}_id=<event_id>\
		    )"
	}

	waveburst {
	    set m [CrossrefMenubutton $tl "Process..."]
	    AddCrossref menuitem $m "Process info" -namevalue \
		    [StdCrQ process creator_db process_id]
	    AddCrossref menuitem $m "Process params" -scrolledtable \
		    [StdCrQ process_params creator_db process_id]

	    set m [CrossrefMenubutton $tl "Filter..."]
	    AddCrossref menuitem $m "Filter info" -namevalue \
		    [StdCrQ filter creator_db filter_id]
	    AddCrossref menuitem $m "Filter params" -namevalue \
		    [StdCrQ filter_params creator_db filter_id]

	    AddCrossref button $tl "MIME record" -scrolledtable \
		    [StdCrQ waveburst_mime creator_db event_id]

	    set m [CrossrefMenubutton $tl "Simulation..."]
	    AddCrossref menuitem $m "Sim type" -namevalue \
		    "SELECT * FROM sim_type WHERE (type=<simulation_type>)"
	    AddCrossref menuitem $m "Sim type params" -scrolledtable \
		    "SELECT * FROM sim_type_params\
		    WHERE (type=<simulation_type>)"
	    AddCrossref menuitem $m "Sim instance" -namevalue \
		    "SELECT * FROM sim_inst\
		    WHERE (creator_db=<creator_db> AND sim_id=<simulation_id>)"
	    AddCrossref menuitem $m "Sim instance params" -scrolledtable \
		    "SELECT * FROM sim_inst_params\
		    WHERE (creator_db=<creator_db> AND sim_id=<simulation_id>)"
	}

	sngl_block {
	    set m [CrossrefMenubutton $tl "Process..."]
	    AddCrossref menuitem $m "Process info" -namevalue \
		    [StdCrQ process creator_db process_id]
	    AddCrossref menuitem $m "Process params" -scrolledtable \
		    [StdCrQ process_params creator_db process_id]

	    set m [CrossrefMenubutton $tl "Filter..."]
	    AddCrossref menuitem $m "Filter info" -namevalue \
		    [StdCrQ filter creator_db filter_id]
	    AddCrossref menuitem $m "Filter params" -namevalue \
		    [StdCrQ filter_params creator_db filter_id]

	    set m [CrossrefMenubutton $tl "Event info..."]
	    AddCrossref menuitem $m "Data source" -scrolledtable \
		    [StdCrQ sngl_datasource creator_db event_id]
	    AddCrossref menuitem $m "Transformed data" -scrolledtable \
		    [StdCrQ sngl_transdata creator_db event_id]
	    AddCrossref menuitem $m "MIME objects" -scrolledtable \
		    [StdCrQ sngl_mime creator_db event_id]
	}

	sngl_unmodeled {
	    set m [CrossrefMenubutton $tl "Process..."]
	    AddCrossref menuitem $m "Process info" -namevalue \
		    [StdCrQ process creator_db process_id]
	    AddCrossref menuitem $m "Process params" -scrolledtable \
		    [StdCrQ process_params creator_db process_id]

	    set m [CrossrefMenubutton $tl "Filter..."]
	    AddCrossref menuitem $m "Filter info" -namevalue \
		    [StdCrQ filter creator_db filter_id]
	    AddCrossref menuitem $m "Filter params" -namevalue \
		    [StdCrQ filter_params creator_db filter_id]

	    AddCrossref button $tl "Result params" -scrolledtable \
		    [StdCrQ sngl_unmodeled_v creator_db event_id]

	    set m [CrossrefMenubutton $tl "Event info..."]
	    AddCrossref menuitem $m "Data source" -scrolledtable \
		    [StdCrQ sngl_datasource creator_db event_id]
	    AddCrossref menuitem $m "Transformed data" -scrolledtable \
		    [StdCrQ sngl_transdata creator_db event_id]
	    AddCrossref menuitem $m "MIME objects" -scrolledtable \
		    [StdCrQ sngl_mime creator_db event_id]

	    AddCrossref button $tl "Coincidences" -scrolledtable \
		    "SELECT * FROM coinc_sngl WHERE (\
		    h1_unmodeled_cdb=<creator_db>\
		    AND h1_unmodeled_id=<event_id> )\
		    OR ( h2_unmodeled_cdb=<creator_db>\
		    AND h2_unmodeled_id=<event_id> )\
		    OR ( l1_unmodeled_cdb=<creator_db>\
		    AND l1_unmodeled_id=<event_id> )"
	}

	sngl_unmodeled_v {
	    AddCrossref button $tl "Event info" -namevalue \
		    [StdCrQ sngl_unmodeled creator_db event_id]
	}

	sngl_dperiodic {
	    set m [CrossrefMenubutton $tl "Process..."]
	    AddCrossref menuitem $m "Process info" -namevalue \
		    [StdCrQ process creator_db process_id]
	    AddCrossref menuitem $m "Process params" -scrolledtable \
		    [StdCrQ process_params creator_db process_id]

	    set m [CrossrefMenubutton $tl "Filter..."]
	    AddCrossref menuitem $m "Filter info" -namevalue \
		    [StdCrQ filter creator_db filter_id]
	    AddCrossref menuitem $m "Filter params" -namevalue \
		    [StdCrQ filter_params creator_db filter_id]

	    set m [CrossrefMenubutton $tl "Extra info..."]
	    AddCrossref menuitem $m "Data source" -scrolledtable \
		    [StdCrQ sngl_datasource creator_db event_id]
	    AddCrossref menuitem $m "Transformed data" -scrolledtable \
		    [StdCrQ sngl_transdata creator_db event_id]
	    AddCrossref menuitem $m "MIME objects" -scrolledtable \
		    [StdCrQ sngl_mime creator_db event_id]
	}

	sngl_datasource {
	    AddCrossref button $tl "Event info" -namevalue \
		    [StdCrQ <event_table> creator_db event_id]
	}

	sngl_transdata {
	    AddCrossref button $tl "Event info" -namevalue \
		    [StdCrQ <event_table> creator_db event_id]
	    AddCrossref button $tl "Full record" -scrolledtable \
			"select * from sngl_transdata\
			where event_id=<EVENT_ID>\
			and creator_db=<CREATOR_DB>\
			and transdata_name='<TRANSDATA_NAME>'"
	}

	sngl_mime {
	    AddCrossref button $tl "Event info" -namevalue \
		    [StdCrQ <event_table> creator_db event_id]
	    AddCrossref button $tl "Full record" -scrolledtable \
			"select * from sngl_mime\
			where sngl_mime_id=<SNGL_MIME_ID>\
			and creator_db=<CREATOR_DB>"
	}

	coinc_sngl {
	    set m [CrossrefMenubutton $tl "Process..."]
	    AddCrossref menuitem $m "Process info" -namevalue \
		    [StdCrQ process creator_db process_id]
	    AddCrossref menuitem $m "Process params" -scrolledtable \
		    [StdCrQ process_params creator_db process_id]

	    set m [CrossrefMenubutton $tl "Participating events..."]
	    foreach {reftable nik descrip} [ list \
		    gds_trigger     gdstrig    "GDS triggers" \
		    sngl_inspiral   inspiral   "Inspirals" \
		    sngl_burst      burst      "Bursts" \
		    sngl_ringdown   ringdown   "Ringdowns" \
		    sngl_unmodeled  unmodeled  "Unmodeled events" ] {
		AddCrossref menuitem $m $descrip -scrolledtable \
			"SELECT * FROM $reftable WHERE (\
			creator_db=<h1_${nik}_cdb> AND event_id=<h1_${nik}_id>\
			) OR (\
			creator_db=<h2_${nik}_cdb> AND event_id=<h2_${nik}_id>\
			) OR (\
			creator_db=<l1_${nik}_cdb> AND event_id=<l1_${nik}_id>\
			)"
	    }
	}

	multi_inspiral -
	multi_burst {
	    set m [CrossrefMenubutton $tl "Process..."]
	    AddCrossref menuitem $m "Process info" -namevalue \
		    [StdCrQ process creator_db process_id]
	    AddCrossref menuitem $m "Process params" -scrolledtable \
		    [StdCrQ process_params creator_db process_id]

	    set m [CrossrefMenubutton $tl "Filter..."]
	    AddCrossref menuitem $m "Filter info" -namevalue \
		    [StdCrQ filter creator_db filter_id]
	    AddCrossref menuitem $m "Filter params" -namevalue \
		    [StdCrQ filter_params creator_db filter_id]
	}

	exttrig_search {
	    set m [CrossrefMenubutton $tl "Process..."]
	    AddCrossref menuitem $m "Process info" -namevalue \
		    [StdCrQ process creator_db process_id]
	    AddCrossref menuitem $m "Process params" -scrolledtable \
		    [StdCrQ process_params creator_db process_id]

	    AddCrossref button $tl "External trigger report" -namevalue \
			"SELECT * FROM external_trigger\
			WHERE (event_id='<exttrig_id>')"
	}

	calib_info {
	}

    }

    return
}

##=========================================================================
## Name: CrossrefMenubutton
##
## Description:
##   Creates a menubutton in the "Cross-ref" area at the bottom of a
##   scrolledtable display.
##   Returns the Tk pathname of the menu, so that commands can be added to it.
## 
## Parameters:
##   tl -- Tk pathname of toplevel widget for scrolledtable display window
##   text -- text to put on the menubutton
##
## Usage:
##   CrossrefMenubutton tl text
##
## Comments:
##   Called from SetupCrossrefs.
##   Creates a frame to hold Cross-ref buttons if it does not already exist.

proc CrossrefMenubutton { tl text } {

    ;##- Create the crossrefs frame if it does not already exist
    if {[winfo exists $tl.crossrefs] == 0} {
	;##- Create a frame for cross-ref buttons
	frame $tl.crossrefs
	label $tl.crossrefs.label -text "Row cross-ref:"
	pack $tl.crossrefs.label -side left -pady 5
	pack $tl.crossrefs -side bottom -anchor w
    }

    set nchildren [llength [winfo children $tl.crossrefs]]
    set buttonname "b$nchildren"

    ;##- Create the specified menubutton (initially disabled)
    menubutton $tl.crossrefs.$buttonname -text $text -pady 1 \
	    -relief raised -borderwidth 2 -direction above -state disabled \
	    -menu $tl.crossrefs.$buttonname.menu

    ;##- Put the button on the screen
    pack $tl.crossrefs.$buttonname -side left -padx 2 -pady 5

    ;##- Create a menu and return its name, so that commands can be added to it
    return [menu $tl.crossrefs.$buttonname.menu -tearoff 0]
}

##=========================================================================
## Name: AddCrossref
##
## Description:
##   Creates a "Cross-ref" button, or adds a command to a Cross-ref
##   menubutton (either of which is at the bottom of a scrolledtable display
##   window) to execute a database query or to create a "build query" dialog.
##
## Parameters:
##   type -- either "button" or "menuitem"
##   w -- Tk widget pathname, either of the toplevel widget for scrolledtable
##        display window (in the case of a button) or of the parent menu (in
##        the case of a menuitem)
##   text -- text to put on the button or menu command
##   options -- see Usage and Comments
##
## Usage:
##   AddCrossref type w text ?-scrolledtable query? ?-namevalue query?
##     ?-dialog table -preset specs?
##
## Comments:
##   Called from SetupCrossrefs.
##   Creates a frame to hold Cross-ref buttons if it does not already exist.
##   Options are used to specify the three different types of operations:
##     1. -scrolledtable query  : 
##        Executes the query and displays the results in a scrolledtable window
##     2. -namevalue query  : 
##        Executes the query and displays the result as name/value pairs;
##        useful when you know the query will only match one database entry
##     3. -dialog table -preset specs  : 
##        Creates a "build query" dialog for the specified table, with one
##        or more qualifier areas pre-set to certain values so that the 
##        query finds entries related to the selected row in the original
##        table.
##   ;#ol
##   "specs" is a comma-separated list (with no embedded spaces!) of items
##   which each may have one of two forms:
##     1. var :
##        The database variable "var" is required to have the same value in the
##        second table as it did in the first table.  This is the more common
##        form, since we generally use the same name for the same variable in
##        different tables
##     2. var=<originalvar> :
##        The database variable "var" in the second table is required to have
##        the same value as the variable "originalvar" in the first
##        table.  This form is needed in a few cases when there is an
##        association between variables with different names
##   ;#ol
##   The angle brackets in form 2 above are literal; this routine replaces this
##   pattern with a Tcl command which, when the button is invoked, looks up the
##   specified value in the selected row and uses that as a preset argument
##   in the call to BuildQueryDialog.  In fact, form 1 above is just
##   shorthand for var=<var>.

proc AddCrossref { type w text args } {

    ;##- Construct the command to associate with the button or menu item
    foreach { opt optval } $args {
###	puts "Found option $opt with value $optval"
	switch -- $opt {
	    -scrolledtable -
	    -namevalue -
	    -listbox {
		set cmd "Db2Submit \"$optval\" [string range $opt 1 end]"
	    }

	    -dialog { set cmd "BuildQueryDialog $optval" }

	    -preset {
		foreach item [split $optval ","] {
		    if { [string first "=" $item] > -1 } {
			;##- User specified what the variable should be
			;##- equal to
			append cmd " -preset $item"
		    } else {
			append cmd " -preset $item=<$item>"
		    }
		}
	    }
	}
    }

    ;##- Determine the name of the toplevel widget
    switch $type {
	button {
	    set tl $w
	}
	menuitem {
	    ;##- Go up 3 levels in the Tk widget hierarchy
	    set tl [winfo parent [winfo parent [winfo parent $w]]]
	}
    }

    ;##- Substitute for any column names in the command, which are indicated
    ;##- by the form:   <columnname>
    regsub -all {<([^>]+)>} $cmd \
	    "\[scrolledtable::scrolledtable $tl.st getrow sel \\1\]" cmd

    ;##- Create the crossrefs frame if it does not already exist
    if {[winfo exists $tl.crossrefs] == 0} {
	;##- Create a frame for cross-ref buttons
	frame $tl.crossrefs
	label $tl.crossrefs.label -text "Cross-ref:"
	pack $tl.crossrefs.label -side left -pady 5
	pack $tl.crossrefs -side bottom -anchor w
    }

    ;##- Now either create the button or add the menu item

    switch $type {

	button {
	    set nchildren [llength [winfo children $tl.crossrefs]]
	    set buttonname "b$nchildren"

	    ;##- Create the specified button (initially disabled)
	    button $tl.crossrefs.$buttonname -text $text -pady 0 \
		    -command "eval \[ReplaceNullEquality \[list $cmd\]\]" \
		    -state disabled

	    ;##- Put the button on the screen
	    pack $tl.crossrefs.$buttonname -side left -padx 2 -pady 5
	}

	menuitem {
	    ;##- Add the command to the menu
	    $w add command -label "- $text" \
		    -command "eval \[ReplaceNullEquality \[list $cmd\]\]"
	}
    }

    return
}

##=========================================================================
## Name: ReplaceNullEquality
##
## Description:
##   Checks SQL query text for comparisons missing values, e.g.
##   "... where (creator_db=)".  Returns a query modified to check if
##   value is null, e.g. "... where (creator_db is null)".
## 
## Parameters:
##   query -- SQL query to be checked
##
## Usage:
##   set newquery [ReplaceNullEquality $query]
##
## Comments:
##   Only looks for equality comparisons.

proc ReplaceNullEquality { query } {
    regsub -all {(\w+)=\s} $query "\\1 is null " query
    regsub {(\w+)=$} $query "\\1 is null" query
    return $query
}

##=========================================================================
## Name: StdCrQ
##
## Description:
##   Convenience procedure to construct standard SQL query for
##   cross-references.
##   Returns the constructed query.
## 
## Parameters:
##   table -- database table to construct query for
##   args -- pieces of SQL query; see Comments
##
## Usage:
##   StdCrQ table arg ...
##
## Comments:
##   Constructs a query of the form:
##   SELECT * FROM table WHERE (var1=<var2>) AND ...
##   The angle brackets are literal here; they are translated in AddCrossref.
##   There can be any number of args.  Each arg can have one of two forms:
##     1. var :
##        The query will include the requirement (var=<var>)
##     2. var1=<var2> (angle brackets are literal):
##        The query will include the requirement (var1=<var2>)
##   ;#ol

proc StdCrQ { table args } {

    set query "SELECT * FROM $table"

    set iarg 0
    foreach arg $args {
	incr iarg
	if { $iarg == 1 } {
	    append query " WHERE "
	} else {
	    append query " AND "
	}

	if { [string first "=" $arg] > -1 } {
	    ;##- User specified what the variable should be equal to
	    append query $arg
	} else {
	    ;##- User didn't specify what the variable should be equal to,
	    ;##- so require it to be the same as in the original table
	    append query "$arg=<$arg>"
	}
    }

    return $query
}

##=========================================================================
## Name: CrossrefPossible
##
## Description:
##   Checks whether the table displayed in a scrolledtable widget contains
##   the information needed to perform a given cross-reference query.
## 
## Parameters:
##   cmd -- Command which is supposed to be executed to do the cross-ref
##   columns -- List of columns present in the table
##
## Usage:
##   CrossrefPossible cmd columns
##
## Comments:
##   Returns 1 if the cross-ref can be done (i.e. the necessary columns are
##   present in the displayed table), or 0 if not.  The column(s) needed
##   for the cross-reference query are determined by scanning the command for
##   things of the form '[scrolledtable::scrolledtable $st getrow sel colname]'

proc CrossrefPossible { cmd columns } {
###    puts "command is $cmd"

    set possible 1

    ;##- Get a list of all the columns needed
    set neededlist {}
    while {[regexp -- {getrow sel (.+?)](.*)$} $cmd match colname rest]} {
	lappend neededlist $colname
	set cmd $rest
    }

    ;##- Check for each needed column in the list of columns present in table
    foreach colname $neededlist {
	set column_is_avail 0
	foreach avail $columns {
	    if {[string equal -nocase $colname $avail]} {
		set column_is_avail 1
		break
	    }
	}
	if { $column_is_avail } {
###	    puts "    column $colname IS available"
	} else {
###	    puts "    column $colname IS NOT available"
	    set possible 0
	}
    }

    return $possible
}

##=========================================================================
## Name: SetupActions
##
## Description:
##   Table-specific code to specify actions to be taken when a user clicks
##   on a value in the table with the middle or right mouse button.  For
##   example, this may convert a GPS time to a UTC time string.
## 
## Parameters:
##   tl -- Tk pathname for toplevel widget of "build query" dialog
##   table -- database table name, used to determine what actions are set up
##
## Usage:
##   SetupActions tl table
##
## Comments:

proc SetupActions { tl table } {
###    puts "In SetupActions for table $table"

    switch -- [string tolower $table] {

	process {
	    scrolledtable::scrolledtable $tl.st B2Action 1 \
		    cvs_entry_time SystimeToUtc
	    scrolledtable::scrolledtable $tl.st B2Action 1 \
		    is_online Interpret_is_online
	    scrolledtable::scrolledtable $tl.st B2Action 1 \
		    start_time GpsToUtc
	    scrolledtable::scrolledtable $tl.st B2Action 2 \
		    start_time SystimeToUtc
	    scrolledtable::scrolledtable $tl.st B2Action 1 \
		    end_time GpsToUtc
	    scrolledtable::scrolledtable $tl.st B2Action 2 \
		    end_time SystimeToUtc
	}

	frameset_chanlist {
	    scrolledtable::scrolledtable $tl.st B2Action 1 start_time GpsToUtc
	    scrolledtable::scrolledtable $tl.st B2Action 1 end_time GpsToUtc
	}

	frameset {
	    scrolledtable::scrolledtable $tl.st B2Action 1 start_time GpsToUtc
	    scrolledtable::scrolledtable $tl.st B2Action 1 end_time GpsToUtc
	}

	segment {
	    scrolledtable::scrolledtable $tl.st B2Action 1 start_time GpsToUtc
	    scrolledtable::scrolledtable $tl.st B2Action 1 end_time GpsToUtc
	}

	summ_value -
	summ_statistics -
	summ_spectrum -
	summ_mime -
	summ_comment {
	    scrolledtable::scrolledtable $tl.st B2Action 1 start_time GpsToUtc
	    scrolledtable::scrolledtable $tl.st B2Action 1 end_time GpsToUtc
	}

	filter {
	    scrolledtable::scrolledtable $tl.st B2Action 1 start_time GpsToUtc
	}

	gds_trigger {
	    scrolledtable::scrolledtable $tl.st B2Action 1 \
		    start_time GpsToUtc
	    scrolledtable::scrolledtable $tl.st B2Action 1 \
		    priority Interpret_gdstrig_priority
	    scrolledtable::scrolledtable $tl.st B2Action 1 \
		    disposition Interpret_gdstrig_disposition
	    scrolledtable::scrolledtable $tl.st B2Action 1 \
		    data Interpret_gdstrig_data
	}

	sngl_inspiral -
	multi_inspiral {
	    scrolledtable::scrolledtable $tl.st B2Action 1 \
		    end_time GpsToUtc
	    scrolledtable::scrolledtable $tl.st B2Action 1 \
		    fout_peak_time GpsToUtc
	}

	sngl_burst -
	waveburst -
	multi_burst -
	sngl_ringdown -
	sngl_unmodeled {
	    scrolledtable::scrolledtable $tl.st B2Action 1 start_time GpsToUtc
	}

	sngl_block -
	sngl_dperiodic {
	    scrolledtable::scrolledtable $tl.st B2Action 1 start_time GpsToUtc
	    scrolledtable::scrolledtable $tl.st B2Action 1 end_time GpsToUtc
	}

	sngl_datasource {
	    scrolledtable::scrolledtable $tl.st B2Action 1 start_time GpsToUtc
	    scrolledtable::scrolledtable $tl.st B2Action 1 end_time GpsToUtc
	}

	coinc_sngl {
	    scrolledtable::scrolledtable $tl.st B2Action 1 coinc_time GpsToUtc
	}

	external_trigger {
	    scrolledtable::scrolledtable $tl.st B2Action 1 \
		    start_time GpsToUtc
	}

	exttrig_search {
	    scrolledtable::scrolledtable $tl.st B2Action 1 start_time GpsToUtc
	    scrolledtable::scrolledtable $tl.st B2Action 1 segment_type \
		    Interpret_segment_type
	}

	calib_info {
	    scrolledtable::scrolledtable $tl.st B2Action 1 valid_start GpsToUtc
	    scrolledtable::scrolledtable $tl.st B2Action 1 valid_end GpsToUtc
	    scrolledtable::scrolledtable $tl.st B2Action 1 origin_time GpsToUtc
	    scrolledtable::scrolledtable $tl.st B2Action 1 caltype \
		    Interpret_caltype
	}

    }

    return
}

##=========================================================================
## Name: GpsToUtc
##
## Description:
##   Routine to convert a GPS time to a UTC string (yyyy/mm/dd hh:mm:ss UTC)
## 
## Parameters:
##   gps -- GPS time in seconds
##
## Usage:
##   GpsToUtc gps
##
## Comments:
##   Intended for use as a "ValuePopup" callback, set up by SetupActions.

proc GpsToUtc { gps } {
    if { [catch {utcTime $gps} systime] } { return "" }
    if { [ catch \
	    {clock format $systime -format {%Y/%m/%d %H:%M:%S UTC} -gmt 1} \
	    utctext ] } {
	return ""
    }
    return $utctext
}

##=========================================================================
## Name: SystimeToUtc
##
## Description:
##   Routine to convert a Unix system time (i.e. seconds since 1970) to
##   a UTC string (yyyy/mm/dd hh:mm:ss UTC)
## 
## Parameters:
##   systime -- Unix system time in seconds
##
## Usage:
##   SystimeToUtc systime
##
## Comments:
##   Intended for use as a "ValuePopup" callback, set up by SetupActions.

proc SystimeToUtc { systime } {
    if { [ catch \
	    {clock format $systime -format {%Y/%m/%d %H:%M:%S UTC} -gmt 1} \
	    utctext ] } {
	return ""
    }
    return $utctext
}

##=========================================================================
## Name: Interpret_is_online
##
## Description:
##   Return a string to interpret the "is_online" code.
## 
## Parameters:
##   is_online
##
## Usage:
##   Interpret_is_online is_online
##
## Comments:
##   Intended for use as a "ValuePopup" callback, set up by SetupActions.

proc Interpret_is_online { is_online } {
    switch -- $is_online {
	0 { return "Offline" }
	1 { return "Online" }
	default { return "(Invalid)" }
    }
}

##=========================================================================
## Name: Interpret_gdstrig_priority
##
## Description:
##   Return a string to interpret the "priority" code for a gds_trigger.
## 
## Parameters:
##   priority
##
## Usage:
##   Interpret_gdstrig_priority priority
##
## Comments:
##   Intended for use as a "ValuePopup" callback, set up by SetupActions.

proc Interpret_gdstrig_priority { priority } {
    switch -- $priority {
	default { return "(No interpretation)" }
    }
}

##=========================================================================
## Name: Interpret_gdstrig_disposition
##
## Description:
##   Return a string to interpret the "disposition" code for a gds_trigger.
## 
## Parameters:
##   disposition
##
## Usage:
##   Interpret_gdstrig_disposition disposition
##
## Comments:
##   Intended for use as a "ValuePopup" callback, set up by SetupActions.

proc Interpret_gdstrig_disposition { disposition } {
    switch -- $disposition {
	default { return "(No interpretation)" }
    }
}

##=========================================================================
## Name: Interpret_gdstrig_data
##
## Description:
##   Return a string to interpret the binary data stored with a gds_trigger.
## 
## Parameters:
##   data
##
## Usage:
##   Interpret_gdstrig_data data
##
## Comments:
##   Intended for use as a "ValuePopup" callback, set up by SetupActions.

proc Interpret_gdstrig_data { data } {
    switch -- $data {
	default { return "(No interpretation)" }
    }
}

##=========================================================================
## Name: Interpret_segment_type
##
## Description:
##   Return a string to interpret the segment type code for an
##   externally-triggered search
## 
## Parameters:
##   typecode
##
## Usage:
##   Interpret_segment_type typecode
##
## Comments:
##   Intended for use as a "ValuePopup" callback, set up by SetupActions.

proc Interpret_segment_type { typecode } {
    switch -- $typecode {
	0 { return "Off-source" }
	1 { return "On-source" }
	default { return "(Unknown)" }
    }
}

##=========================================================================
## Name: Interpret_caltype
##
## Description:
##   Return a string to interpret the calibration type bitmask
## 
## Parameters:
##   typecode
##
## Usage:
##   Interpret_caltype typecode
##
## Comments:
##   Intended for use as a "ValuePopup" callback, set up by SetupActions.

proc Interpret_caltype { typecode } {
    set interp ""
    foreach bitval [list 1 2 4 8 16] component \
	    [list Amplitude Offset TimeDelay TransferFunction PoleZero] {
	if { $typecode & $bitval } {
	    if { $interp == "" } {
		set interp $component
	    } else {
		append interp ",$component"
	    }
	}
    }
    if { $interp == "" } { set interp "(none)" }
    return $interp
}

##=========================================================================
## Name: SetupNextQ
##
## Description:
##   If	it seems like the result table was artificially limited to some number
##   of rows, set up a button which triggers a query to get the next block
##   of rows from the same table.
##
## Usage:
##   SetupNextQ tl query

proc SetupNextQ { tl query } {
###    puts "\n----------- In SetupNextQ with $tl $query"

    if { ! [winfo exists $tl] } { return }

    ;##- Get access to the state array for the scrolledtable
    upvar #0 scrolledtable::state$tl.st state

    ;##- See how many rows there are in the table
    set nrows $state(nRows)
###    puts "\nnrows is $nrows"

    ;##- Parse the query to see how many rows were requested
    if { ! [regexp -nocase {fetch +first +(\d+) +rows} $query match nreq] } {
	set nreq 1000000000
    }
    if { $nrows < $nreq } {
	;##- The query returned fewer rows than we asked for.
	;##- Did we hit the hard limit imposed by LDAS?
	if { $nrows != 10000 && $nrows != 100000 && $nrows != 1000000 } {
	    ;##- There doesn't seem to be anything special about the number
	    ;##- of rows returned, so it is pretty safe to assume we got
	    ;##- everything there was to get.
###	    puts "Nothing special about the number of rows"
	    return
	} else {
	    ;##- It looks like we hit the hard limit imposed by LDAS.
	    ;##- Pop up a warning message
	    set ignore [ tk_messageBox -type ok -icon warning \
		    -title "Table was probably truncated" -parent $tl \
		    -message "WARNING: the fact that the table returned by\
		    LDAS has exactly $nrows rows suggests that LDAS probably\
		    limited the output to this number of rows." ]
	    ;##- Modify the "number requested" to be LDAS's limit
	    set nreq $nrows
	}
    }
###    puts "nreq is $nreq"

    if { ! [winfo exists $tl.st.rownums] } return

    ;##- See what the last row number is in the table
    set lastrow [$tl.st.rownums get "end-1line linestart" "end-1line lineend"]
###    puts "Last row number is $lastrow"

    ;##- Parse the query to see what columns were used to sort the output
    if { ! [regexp -nocase {order +by +(\S+ *(, *\S+)*)} $query \
	    match sortpart] } {
	;##- The query output seems to be un-ordered
	;##- Place a disabled button to remind the user
	button $tl.next -text "Not ordered" -font normhelv \
		-padx 0 -pady 0 -state disabled
	place $tl.next -in $tl -relx 0 -rely 1 -anchor sw
	return
    }

###    puts "sort part of query is: $sortpart"

    ;##- Make sure each element in the sorting list is a simple column name
    ;##- But allow one or more items at the end of the list to be absent
    set firstitem 1
    set skip 0
    set hidden 0
    set sortcols [string tolower [regexp -all -inline {[^ ,]+} $sortpart]]
    foreach sortitem $sortcols {
	set icol -1
	set jcol -1
	foreach name $state(columnNames) {
	    incr jcol
	    if {[string equal -nocase $sortitem $name]} {
		set icol $jcol
		break
	    }
	}
	if { $firstitem && $icol == -1 } {
###	    puts "First item in list ($sortitem) is not a column included in the query"
	    set hidden 1
	    break
	}
	set firstitem 0

	if { $skip } {
	    if { $icol >= 0 } {
###		puts "$sortitem is in the query, but is after an item not in the query"
		set hidden 1
		break
	    }
	} elseif { $icol == -1 } {
	    ;##- It's OK for items at the end of the list to be absent, as long
	    ;##- as ALL of them are
	    set skip 1
	} else {
###	    puts "$sortitem is column number $icol"
	}
    }

    if { $hidden } {
	;##- Place a disabled button to remind the user
	button $tl.next -text "Hidden ordering" -font normhelv \
		-padx 0 -pady 0 -state disabled
	place $tl.next -in $tl -relx 0 -rely 1 -anchor sw
	return
    }

    ;##- Now get the values for these columns for the last row in the table
    foreach colname $sortcols {
	set val($colname) \
		[scrolledtable::scrolledtable $tl.st getrow end $colname]
    }

    ;##- Try to identify a unique ID also in the table.  There is a hierarchy
    ;##- of which unique ID takes precedence.
    set uidcol ""
    set class 0
    foreach colname [string tolower $state(columnNames)] {
	;##- Make sure this column is not already in the order-by list
	if { [lsearch -exact $sortcols $colname] >= 0 } { continue }
###	puts "  Considering $colname for a unique-ID column"

	if { $class < 4 } {
	    if { [regexp \
		    {^(event|coinc|sngl_mime|summ_mime|summ_comment)_id$} \
		    $colname] } {
		set uidcol $colname
		set class 4
		break
	    }
	}
	if { $class < 3 } {
	    if { [regexp {^(start|end)_time_ns$} $colname] } {
		set uidcol $colname
		set class 3
	    }
	}
	if { $class < 2 } {
	    if { [regexp {^(filter|chanlist)_id$} $colname] } {
		set uidcol $colname
		set class 2
	    }
	}
	if { $class < 1 } {
	    if { [regexp {^(process)_id$} $colname] } {
		set uidcol $colname
		set class 1
	    }
	}
    }

    ;##- If no suitable unique-ID column could be identified, just return
    ;##- At least for now, require a true unique ID (class 4)
    if { $class < 4 } {
###	puts "No suitable unique-ID column could be identified"
	;##- Place a disabled button to remind the user
	button $tl.next -text "No unique ID" -font normhelv \
		-padx 0 -pady 0 -state disabled
	place $tl.next -in $tl -relx 0 -rely 1 -anchor sw
	return
    }

###    puts "Selected as unique ID: $uidcol"

    ;##- For all rows at the end of the table with the same values of all the
    ;##- order-by columns, get a list of values for the unique-ID column
    set uidlistlen 0
    set irow [expr {$nrows+1}]
    while { 1 } {
	incr irow -1
	if { $irow < 1 || $uidlistlen >= 50 } {
	    ;##- Too many values to keep track of (or the whole table)
###	    puts "Too many 'unique' values to keep track of!"
	    return
	}

	set break 0
	foreach colname $sortcols {
	    if { ! [string equal $val($colname) \
		  [scrolledtable::scrolledtable $tl.st getrow $irow $colname] \
		    ] } { set break 1 }
	}
	if { $break } { break }

	set uidval [scrolledtable::scrolledtable $tl.st getrow $irow $uidcol]
        ;##- See whether this is a numeric value or a string
        if { ! [regexp {^[\d\.e+-]+$} $uidval] \
		&& ! [regexp {^x'.+'$} $uidval] } {
            ;##- String
            set uidval "'$uidval'"
        }
	if { $uidlistlen == 0 } {
	    set uidlist $uidval
	} else {
	    append uidlist ",$uidval"
	}
	incr uidlistlen
    }

    ;##- Enclose string values in single quotes
    foreach colname $sortcols {
	if { ! [regexp {^[\d\.e+-]+$} $val($colname)] \
		&& ! [regexp {^x'.+'$} $val($colname)] } {
            ;##- String
            set val($colname) "'$val($colname)'"
        }
    }

    ;##- Construct the query qualifier
    set metaqual ""
    foreach colname $sortcols {
	append metaqual \
		"($colname>\$val($colname) Or ($colname=\$val($colname) And "
    }
    append metaqual "$uidcol not in (\$uidlist)"
    append metaqual [string repeat ")" [expr {2*[llength $sortcols]}]]
###    puts "\nmeta-qualifier is: $metaqual"

    ;##- Substitute variables to get the actual qualifier
    set qual [subst $metaqual]
###    puts "\nactual qualifier is $qual"

    ;##- Derive the qualifier pattern
    regsub -all {[\(\)$]} $metaqual {\\&} qualpat
###    puts "\nsub1: $qualpat"
    regsub -all {\\\$val\\\(\w+\\\)} $qualpat {.+?} qualpat
###    puts "\nsub2: $qualpat"
    regsub {\\\$uidlist} $qualpat {[^\)]+} qualpat
###    puts "\nqualifier pattern is $qualpat"

    ;##- Substitute actual qualifier in for the one used previously, or
    ;##- if there was no previous qualifier, insert at appropriate place
    if { ! [regsub $qualpat $query $qual newquery] } {
	;##- Query did not match the pattern, so just insert qualifier
	regexp -nocase {^(.+)( order +by .+)$} $query match part1 part2

###	puts "\npart1 is $part1\npart2 is $part2"

	set work [string tolower $part1]
	set idx [string last " where " $work]
	if { $idx > -1 } {
	    set newquery "$part1 And $qual$part2"
	} else {
	    set newquery "$part1 WHERE $qual$part2"
	}
    }

###    puts "\nNew query is $newquery"

    ;##- Create a button to submit the query
    button $tl.next -text "Next $nreq rows" -font normhelv \
	    -padx 0 -pady 0 \
	    -command [list Db2Submit $newquery \
	    "scrolledtable -rowoffset $lastrow"]
    place $tl.next -in $tl -relx 0 -rely 1 -anchor sw

    return
}


##=========================================================================
## Name: UpdateStatus
##
## Description:
##   Updates the contents of the status bar in the main guild window.
## 
## Parameters:
##   message -- message to display ("" to clear status area)
##
## Usage:
##   UpdateStatus message
##
## Comments:
##   Called by various routines.
##   If the message is blank, constructs a standard message based on the
##   number of jobs running or in an error state.
##   Sets the background color based on the contents of some global variables.

proc UpdateStatus { { message "" } } {

    if {$message != ""} {
	.status config -state normal -background $::statusBgRun
	.status delete 0.0 end
	.status insert end $message
	.status config -state disabled
	update idletasks
	return
    }

    
    set nactive 0
    set nerror 0
    foreach guildJobId $::guildJobsActive {
	if { $::jobToplevel($guildJobId) != "" } {
	    if { $::jobStatus($guildJobId) == "error" } {
		incr nerror
	    } elseif { $::jobStatus($guildJobId) != "finished" } {
		incr nactive
	    }
	}
    }

    if { $nactive != 1 } { set aplural s } else { set aplural "" }
    if { $nerror != 1 } { set eplural s } else { set eplural "" }

    if { $nerror == 0 } {
	if { $nactive == 0 } {
	    set message ""
	} else {
	    set message "$nactive job$aplural running"
	}
    } else {
	if { $nactive == 0 } {
	    set message "$nerror job$eplural ended with error"
	} else {
	    set message "$nerror job$eplural ended with error;\
		    $nactive job$aplural running"
	}
    }

    if { ! [string is space $message] } {
	if { $nerror == 0 } {
	    set color $::statusBgRun
	} else {
	    set color $::statusBgError
	}
	.status config -state normal -background $color
	.status delete 0.0 end
	.status insert end $message
	.status config -state disabled
    } else {
	.status config -state normal -background $::statusBgIdle
	.status delete 0.0 end
	.status config -state disabled
    }

    update idletasks

    return
}

##=========================================================================
## Name: BigMessageBox
##
## Description:
##   Pop a window to display a message of arbitrary length, asking
##   the user to click 'OK'.  Similar to tk_messageBox, but provides a
##   larger, scrollable text area.
## 
## Parameters:
##   ?options? -- See Usage and Comments
##
## Usage:
##   BigMessageBox -icon icon -title title -message message ?-grab 1?
##
## Comments:
##   The icon must be one of the Tk built-in bitmaps (error, gray50, info,
##   question, gray12, hourglass, questhead, warning).  If the icon is
##   "error", then this proc turns the background of the status area (in
##   the main guild window) red and grabs the focus until the user clicks OK.

proc BigMessageBox { args } {

    ;##- Set defaults
    set title "Message"
    set message ""
    set icon "gray50"
    set grab 0
    set bg $::bgColor
    set width 72
    set height 10
    set xscroll 0

    ;##- Check options
    foreach { opt optval } $args {
	set [string trim $opt -] $optval
    }

    if {$icon == "error"} { set grab 1 }

###    set retval [ tk_messageBox -type ok -icon $icon \
###	    -title $title -message $message ]

    ;##- Create a new toplevel window with the specified title
    set tl [NewToplevel]
    wm title $tl $title

    ;##- Create some widgets
    frame $tl.msg
    label $tl.msg.bitmap -bitmap $icon -foreground red
    scrollbar $tl.msg.yscroll -orient vertical \
	    -command "$tl.msg.text yview"
    text $tl.msg.text -width $width -height $height -wrap word -setgrid true \
	-yscrollcommand "$tl.msg.yscroll set" -bg $bg
    grid $tl.msg.bitmap $tl.msg.text $tl.msg.yscroll -sticky news
    if { $xscroll } {
	scrollbar $tl.msg.xscroll -orient horizontal \
	    -command "$tl.msg.text xview"
	$tl.msg.text configure -xscrollcommand "$tl.msg.xscroll set" -wrap none
	grid $tl.msg.xscroll -sticky news -row 1 -column 1
    }
    bind $tl.msg.text <Button> "focus %W"

    if {$grab} {
	button $tl.ok -text "OK" -default active \
		-command "catch {grab release $tl}; focus [focus]; destroy $tl"
    } else {
	button $tl.ok -text "OK" -command "destroy $tl" -default active
    }

    grid rowconfigure $tl.msg 0 -weight 1
    grid columnconfigure $tl.msg 1 -weight 1

    ;##- Lay out the remaining widgets
    pack $tl.ok -side bottom
    pack $tl.msg -side top -fill both -expand true

    ;##- Bind the Return key to the OK button
    bind $tl <Return> "$tl.ok invoke"

    ;##- Insert the message into the text widget, then disable it
    $tl.msg.text insert end $message
    $tl.msg.text config -state disabled

    if {$grab} {
	if {$icon == "error"} {
	    ;##- Turn the status area red
	    set savecolor [.status cget -background]
	    .status config -background red
	}

	;##- Grab the focus until the user clicks on the OK button
	set oldfocus [focus]
	focus $tl
## We don't actually want to grab control of guild (i.e. block keyboard/mouse
## input to all other guild windows); instead, we have a binding which keeps
## the error window on top of all other guild windows.
##	catch {grab $tl}
	set ::errorWindow $tl

	;##- Wait for the window to be destroyed
	tkwait window $tl

	if {$icon == "error"} {
	    ;##- Restore the color of the status area
	    .status config -background $savecolor
	}
    }

    return
}


##=========================================================================
## Name: Cursor
##
## Description:
##   Changes the cursor to/from a 'watch'
##
## Usage:
##   Cursor busy
##   Cursor normal
##
## Comments:
##   Changes cursor for ALL toplevel windows

proc Cursor {state} {

    if { ! [info exists ::windowStack] } return

    switch -- $state {
	"busy" {
	    foreach window $::windowStack {
		if { [winfo exists $window] } {
		    $window config -cursor "watch"
		}
	    }
	}
	default {
	    foreach window $::windowStack {
		if { [winfo exists $window] } {
		    $window config -cursor {}
		}
	    }
	}
    }

    return
}


##=========================================================================
## Name: ShowVersion
##
## Description:
##   Pop up the "Version Information" window.
##
## Usage:
##   ShowVersion
##
## Comments:
##   Called from the "Help" menu in the main window menubar.

proc ShowVersion {} {

    ;##- If window already exists, bring it forward
    if {[winfo exists .version]} {
	switch -- [wm state .version] {
	    normal { raise .version; focus .version }
	    withdrawn -
	    iconic { wm deiconify .version; focus .version }
	}
    } else {
	;##- Create a new window
	set tl [NewToplevel .version]
	wm title $tl "Version information"

	if {$::winIcons} {
	    ;##- Also create an icon for this window
	    NewToplevel ${tl}Icon -icon -width 48 -height 48 \
		    -highlightthickness 0
	    label ${tl}Icon.bitmap -image infoIcon
	    pack ${tl}Icon.bitmap -side top -fill x
	    wm iconwindow $tl ${tl}Icon
	}

	frame $tl.title
	label $tl.title.program_name -justify center -font bighelv \
		-text "guild"
	message $tl.title.program_description -justify center -aspect 10000 \
		-font normhelv \
		-text "Graphical User Interface\nto LIGO Databases"
	pack $tl.title.program_name -side left
	pack $tl.title.program_description -side left
	pack $tl.title -side top

	;##- Construct the message text
	set msg "Software and information can be found at\n"
	append msg " http://ldas-sw.ligo.caltech.edu/ligotools/guild "
	append msg "\n\nCreated by Peter Shawhan\n(shawhan_p@ligo.caltech.edu)"
	append msg "\nwith contributions by Alex Ivanov and Mary Lei"

	append msg "\n\nVersion $::guildVersion"

	;##- Figure out whether this is the script or standalone version
	if { ! [info exists ::et_version] || \
		[regexp wishexe [file tail [info nameofexecutable]]] } {
	    set exetype "script"
	} else {
	    set exetype "executable"
	}
	append msg " $exetype"

	switch -- $::guildPatchStatus {
	    "no_server" -
	    "no_connect" {
		append msg "\nUnable to check web site for patches!"
	    }

	    "locally_patched" {
		if { $::guildPatchVersion == $::guildVersion } {
		    append msg "\nThis version does not require patching"
		} else {
		    append msg "\nPatched from local file to reach\
			    Version $::guildPatchVersion"
		}
	    }

	    "no_file" {
		append msg "\nWeb site has no patch file for this version"
	    }

	    "OK" {
		if { $::guildPatchVersion == $::guildVersion } {
		    append msg "\nThis version does not require patching"
		} else {
		    append msg "\nWeb-patched to reach\
			    Version $::guildPatchVersion"
		}
	    }
	}

	append msg "\n\nRunning under Tcl/Tk version [info patchlevel]"
	append msg "\n(http://tcl.activestate.com/software)"

	if { $exetype == "script" } {
	    if { ! [regexp wishexe [file tail [info nameofexecutable]]] } {
		append msg "\n\nwish executable"
		append msg "\n[info nameofexecutable]"
		if { [info exists ::tcl_platform(threaded)] } {
		    append msg "\ncompiled with thread support"
		} else {
		    append msg "\ncompiled without thread support"
		}
	    } else {
		append msg "\n\nStandalone wishexe executable"
		append msg "\n[info nameofexecutable]"
		if { [info exists ::et_version] } {
		    append msg "\nbuilt using 'mktclapp' version $::et_version"
		    append msg "\n(mktclapp created by D. Richard Hipp,"
		    append msg "\nhttp://www.hwaci.com/sw/mktclapp)"
		}
		if { [info exists ::tcl_platform(threaded)] } {
		    append msg "\nTcl core compiled with thread support"
		} else {
		    append msg "\nTcl core compiled without thread support"
		}
	    }
	}

	if { $exetype == "executable" } {
	    append msg "\n\nStandalone guild executable"
	    append msg "\n[info nameofexecutable]"
	    if { [info exists ::freewrap::patchLevel] } {
		append msg "\nbuilt using 'freeWrap'\
			version $::freewrap::patchLevel"
		append msg "\n(freeWrap created by Dennis LaBelle,"
		append msg "\nhttp://home.nycap.rr.com/dlabelle/freewrap)"
		append msg "\nwhich, in turn, was"
	    }
	    if { [info exists ::et_version] } {
		append msg "\nbuilt using 'mktclapp' version $::et_version"
		append msg "\n(mktclapp created by D. Richard Hipp,"
		append msg "\nhttp://www.hwaci.com/sw/mktclapp)"
	    }
	    if { [info exists ::tcl_platform(threaded)] } {
		append msg "\n\nTcl core compiled with thread support"
	    } else {
		append msg "\n\nTcl core compiled without thread support"
	    }
	}

	;##- Figure out how big to make the text widget
	set width 0
	set height 0
	foreach line [split $msg "\n"] {
	    incr height
	    set chars [string length $line]
	    if { $chars > $width } {
		set width $chars
	    }
	}

	;##- Create a message widget with the text
	text $tl.msg -relief flat -width $width -height $height
	bind $tl.msg <Button> "focus %W"
	$tl.msg tag configure centered -justify center
	$tl.msg insert end $msg centered
	$tl.msg configure -state disabled
	pack $tl.msg -side top

	;##- Create a "Close" button
	button $tl.close -text "Close" -command "wm withdraw $tl" \
		-default active

	;##- Bind the Return key to the Close button
	bind $tl <Return> "$tl.close invoke"

	pack $tl.close -side top
    }

    return
}

##=========================================================================
## Name: ShowGeneralHelp
##
## Description:
##   Pop up the "General information" window.
##
## Usage:
##   ShowGeneralHelp
##
## Comments:
##   Called from the "Help" menu in the main window menubar.

proc ShowGeneralHelp {} {

    ;##- If window already exists, bring it forward
    if {[winfo exists .generalhelp]} {
	switch -- [wm state .generalhelp] {
	    normal { raise .generalhelp; focus .generalhelp }
	    withdrawn -
	    iconic { wm deiconify .generalhelp; focus .generalhelp }
	}
    } else {
	;##- Create a new window
	set tl [NewToplevel .generalhelp]
	wm title $tl "General information about guild"
	wm iconname $tl "General information"

	if {$::winIcons} {
	    ;##- Also create an icon for this window
	    NewToplevel ${tl}Icon -icon -width 48 -height 48 \
		    -highlightthickness 0
	    label ${tl}Icon.bitmap -image helpIcon
	    pack ${tl}Icon.bitmap -side top -fill x
	    wm iconwindow $tl ${tl}Icon
	}

	;##- Create a frame with a text widget and a scrollbar
	frame $tl.msg
	text $tl.msg.text -width 76 -height 16 -wrap word \
		-yscrollcommand "$tl.msg.yscroll set" -setgrid true
	bind $tl.msg.text <Button> "focus %W"
	scrollbar $tl.msg.yscroll -orient vertical \
		-command "$tl.msg.text yview"

	;##- Set up at tag to center the title
	$tl.msg.text tag configure centered -justify center

	;##- Insert the title into the text widget
	$tl.msg.text insert end "\nGeneral information about guild\n" centered

	;##- Insert the message into the text widget
	$tl.msg.text insert end {
The LIGO Data Analysis System (LDAS) uses commercial database software\
to provide core database functions, with LIGO software layers on top to\
manage database access from remote computers, do format translations,\
etc.  The IBM DB2 "Universal Database" has been selected for the underlying\
database software, at least for the forseeable future.  This is a\
relational database which uses the SQL query language to insert and\
retrieve information.  All information is stored in "tables", each with\
a fixed number of pre-defined columns and a variable number of rows which\
represent database entries.
	} {} {
SQL is very flexible but somewhat arcane; therefore, a major goal of this\
graphical user interface is to provide a more intuitive means of accessing\
the contents of the database, through dialog windows and point-and-click\
operations.
	} {} {
Access to the database requires an LDAS username and password (NOT the
same as any of your Unix usernames/passwords) to be entered\
before the first query can be executed.  You will be prompted for these.
	} {} {
Besides direct database access, guild can display the contents of files\
generated by past database queries, or by user analysis programs (even\
if data is stored in non-standard tables).  Just choose "Open File" from\
the File menu.  It can also display the contents of files retrieved from\
web servers, by choosing "Open URL" from the File menu.
	} {} {
Guild also provides an interface to retrieve frame data from the LDAS systems\
running at the interferometer sites.  However, it does not attempt to display\
the data; it just writes it to disk.
	} {} {
Finally, guild provides a few miscellaneous utility functions, including a\
graphical interface to launch any LDAS user command, and a time converter\
which translates between GPS, UTC, and local time.
	} {} {
Bug reports, comments and suggestions may be directed to Peter Shawhan\
(shawhan_p@ligo.caltech.edu).
	} {} {
Some additional information about guild, including a "Getting Started" guide,\
may be found at http://ldas-sw.ligo.caltech.edu/ligotools/guild
	} {} {
General information about LDAS may be found at\
http://ldas-sw.ligo.caltech.edu
	}

	;##- Disable modifications to the text widget
	$tl.msg.text config -state disabled

	;##- Create a "Close" button
	button $tl.close -text "Close" -command "wm withdraw $tl" \
		-default active

	;##- Bind the Return key to the Close button
	bind $tl <Return> "$tl.close invoke"

	;##- Lay out the widgets
	pack $tl.close -side bottom
	grid $tl.msg.text $tl.msg.yscroll -sticky news
	grid rowconfigure $tl.msg 0 -weight 1
	grid columnconfigure $tl.msg 0 -weight 1
	pack $tl.msg -side top -fill both -expand true
    }

    return
}

##=========================================================================
## Name: ShowQueryHelp
##
## Description:
##   Pop up the help window related to building database queries.
##
## Usage:
##   ShowQueryHelp
##
## Comments:
##   Called when the user presses the "Help" button at the bottom of a
##   "build query" dialog.

proc ShowQueryHelp {} {

    ;##- If window already exists, bring it forward
    if {[winfo exists .queryhelp]} {
	switch -- [wm state .queryhelp] {
	    normal { raise .queryhelp; focus .queryhelp }
	    withdrawn -
	    iconic { wm deiconify .queryhelp; focus .queryhelp }
	}
    } else {
	;##- Create a new window
	set tl [NewToplevel .queryhelp]
	wm title $tl "Help on building queries"
	wm iconname $tl "Metadata queries"

	if {$::winIcons} {
	    ;##- Also create an icon for this window
	    NewToplevel ${tl}Icon -icon -width 48 -height 48 \
		    -highlightthickness 0
	    label ${tl}Icon.bitmap -image helpIcon
	    pack ${tl}Icon.bitmap -side top -fill x
	    wm iconwindow $tl ${tl}Icon
	}

	;##- Create a frame with a text widget and a scrollbar
	frame $tl.msg
	text $tl.msg.text -width 76 -height 16 -wrap word \
		-yscrollcommand "$tl.msg.yscroll set" -setgrid true
	bind $tl.msg.text <Button> "focus %W"
	scrollbar $tl.msg.yscroll -orient vertical \
		-command "$tl.msg.text yview"

	;##- Set up at tag to center the title
	$tl.msg.text tag configure centered -justify center

	;##- Insert the title into the text widget
	$tl.msg.text insert end "\nHelp on building queries\n" centered

	;##- Insert the message into the text widget
	$tl.msg.text insert end {
An SQL query is constructed using the information you enter in the\
"build query" window.  In general, the window presents you with several\
lines of "qualifiers" which may be used to limit the query based on the\
values of variables in the database record.  If a checkbox at the left\
edge of the window is red, then that qualifier will be used to limit the\
query.  You may click on these checkboxes to enable/disable qualifiers.
	} {} {
For text variables, the following comparisons are available.  Note that\
text comparisons are NOT case-sensitive by default, but can be made so\
using the option menu just above the qualifiers area.
	}

	;##- Set up a tag to control indentation for the list of comparisons
	set charwidth [font measure [$tl.msg.text cget -font] X]
	$tl.msg.text tag configure complist -lmargin2 [expr {24*$charwidth}]

	$tl.msg.text insert end {
  "is":              The variable must match the specified value exactly.
	} complist {
  "is null or"       The variable must match the specified value exactly, or\
          else be null (i.e. not specified when the database entry was made).
	} complist {
  "is one of":       The variable must exactly match one of a list of\
	  values, which may be separated by spaces and/or commas.  (The values\
	  themselves must not contain spaces or commas.)
	} complist {
  "is not":          The variable must NOT match the specified value exactly.
	} complist {
  "is not any of":   The variable must NOT exactly match any item in a list of\
	  values, which may be separated by spaces and/or commas.  (The values\
	  themselves must not contain spaces or commas.)
	} complist {
  "matches":         The variable must match the specified pattern. \
	  Unix-style wildcards * and ? may be used; they will be translated\
	  into SQL-style wildcards.
	} complist {
  "does not match":  The variable must NOT match the specified pattern.
	} complist {
  "contains":        The variable must contain the specified string,\
	  which may have embedded spaces and/or commas.  Unix-style wildcards\
	  * and ? may be used.
	} complist {
  "contains one of": The variable must contain at least one of a list\
	  of strings, separated by spaces and/or commas.  (The strings must\
	  not contain any spaces or commas.)
	} complist {
  "contains all of": The variable must contain all of the strings in\
	  the specified list.
	} complist

	$tl.msg.text insert end {
For numeric variables, the comparisons are pretty self-explanatory. \
When doing a "between" comparison, you must enter two values separated by\
the word AND.  (The AND will be inserted for you when you select "between".)
	} {} {
Times may be specified in GPS seconds or as an arithmetic expression\
giving GPS seconds, such as "630454213-21*60*60". \
Times may also be specified as nearly any unambiguous date-time string,\
such as "jan 1 2001" (midnight at the beginning of January 1 in the year\
2001), "Jan 15 5:04" (5:04 on January 15 of the current year),\
"1/19/01 5:15", "19-jan-2001 18:45 cst", "today 3:24pm pdt",\
"now", "now-1000sec", "now -1hour", "now - 3 days", etc. \
Times are assumed to be UTC unless you specify a time zone.
	} {} {
A "List" button is provided next to some qualifiers.  When pressed, this\
generates a list of all distinct values of the variable in\
question.  Double-clicking on an item in the list adds it to the entry area\
for the appropriate qualifier.
	} {} {
If you enter a value which is wider than the entry area provided, you can\
scroll the contents by dragging with the middle mouse button.  Pressing\
<Return> causes the SQL query to be refreshed (but NOT submitted)  To\
submit a query, you must click with the mouse on the "Refresh & Submit" button.
	}

	;##- Disable modifications to the text widget
	$tl.msg.text config -state disabled

	;##- Create a "Close" button
	button $tl.close -text "Close" -command "wm withdraw $tl" \
		-default active

	;##- Bind the Return key to the Close button
	bind $tl <Return> "$tl.close invoke"

	;##- Lay out the widgets
	pack $tl.close -side bottom
	grid $tl.msg.text $tl.msg.yscroll -sticky news
	grid rowconfigure $tl.msg 0 -weight 1
	grid columnconfigure $tl.msg 0 -weight 1
	pack $tl.msg -side top -fill both -expand true
    }

    return
}

##=========================================================================
## Name: ShowScrolledTableHelp
##
## Description:
##   Pop up the help window giving information about a scrolledtable display
##   window, e.g. what the buttons do and how to select rows/columns.
##
## Usage:
##   ShowQueryHelp
##
## Comments:
##   Called when the user presses the "Help" button at the bottom of a
##   scrolledtable display window.

proc ShowScrolledTableHelp {} {

    ;##- If window already exists, bring it forward
    if {[winfo exists .scrolledtablehelp]} {
	switch -- [wm state .scrolledtablehelp] {
	    normal { raise .scrolledtablehelp; focus .scrolledtablehelp }
	    withdrawn -
	    iconic { wm deiconify .scrolledtablehelp; \
		    focus .scrolledtablehelp }
	}
    } else {
	;##- Create a new window
	set tl [NewToplevel .scrolledtablehelp]
	wm title $tl "Help on table display"
	wm iconname $tl "Table display"

	if {$::winIcons} {
	    ;##- Also create an icon for this window
	    NewToplevel ${tl}Icon -icon -width 48 -height 48 \
		    -highlightthickness 0
	    label ${tl}Icon.bitmap -image helpIcon
	    pack ${tl}Icon.bitmap -side top -fill x
	    wm iconwindow $tl ${tl}Icon
	}

	;##- Create a frame with a text widget and a scrollbar
	frame $tl.msg
	text $tl.msg.text -width 76 -height 16 -wrap word \
		-yscrollcommand "$tl.msg.yscroll set" -setgrid true
	bind $tl.msg.text <Button> "focus %W"
	scrollbar $tl.msg.yscroll -orient vertical \
		-command "$tl.msg.text yview"

	;##- Set up at tag to center the title
	$tl.msg.text tag configure centered -justify center

	;##- Insert the title into the text widget
	$tl.msg.text insert end "\nHelp on table display\n" centered

	;##- Insert the message into the text widget
	$tl.msg.text insert end {
The result of a database query is normally displayed as a table with several\
named columns and one or more numbered rows.  The table is often bigger than\
the window, but scrollbars allow you to move around without losing track of\
the column names or row numbers.  You can use the mouse to select text in the\
main text area and paste it into some other window; note that the values on a\
given row are separated by tabs.  Also note that row numbers are assigned to\
the records returned by the query for display convenience only, and bear no\
relation to the organization of records in the database.
	} {} {
You can select a column by clicking on the column name, and deselect by\
clicking again.  Selected columns can be resized or "hidden" (shrunk to\
minimal width) to help you arrange for all the values you are interested\
in to be visible at the same time.  (Use the "Hide" button or Alt-h, etc.;\
you can also double-click on a column name to toggle its hidden/shown\
state.)  The full name of the selected column is shown above the table, even\
if the column is hidden or is too narrow to display the whole column name.  If\
a value is too wide for the current column size, it is truncated; a red plus\
sign is appended to indicate that truncation has occurred.
	} {} {
You can select a row by clicking on the row number, and deselect by clicking\
again.  When a row is selected, there are generally some "Cross-ref" buttons\
and/or menubuttons below the table which become active to let you find\
related information stored in other database tables.  In some cases, these\
buttons immediately execute a query and display the results in a new window;\
in other cases, they bring up a "build query" window, with some qualifiers\
already set, which you can further modify (e.g. by limiting the search to a\
given time interval) before submitting a query.  (If a button or menu item\
stays gray when a row is selected, it is because the displayed table does not\
contain the column(s) needed to perform that\
cross-reference.)  Double-clicking on a row number creates a new window\
listing the column-name/value pairs for that row.
	} {} {
Clicking in the table itself with the left mouse button selects text in the\
usual manner.  Clicking with the middle mouse button pops up a little white\
box over the value you clicked on; the box may contain the value itself (in\
its entirety, even if the current column width is too narrow to display it)\
or some other useful information, such as a GPS time re-expressed as a UTC\
date/time string.  The popup box disappears when the middle mouse button is\
released.
	} {} {
The source filename and query (if applicable) are shown at the bottom of the\
screen.  If the query is wider than the window, then you can scroll it by\
dragging with the middle mouse button, or display it in a separate window by\
clicking on the "Full" button.  You can save the table contents, either in the\
original format (normally LIGO_LW) or as text (with various formatting\
options) using the "Save as..." button.
	}

	;##- Disable modifications to the text widget
	$tl.msg.text config -state disabled

	;##- Create a "Close" button
	button $tl.close -text "Close" -command "wm withdraw $tl" \
		-default active

	;##- Bind the Return key to the Close button
	bind $tl <Return> "$tl.close invoke"

	;##- Lay out the widgets
	pack $tl.close -side bottom
	grid $tl.msg.text $tl.msg.yscroll -sticky news
	grid rowconfigure $tl.msg 0 -weight 1
	grid columnconfigure $tl.msg 0 -weight 1
	pack $tl.msg -side top -fill both -expand true
    }

    return
}

##=========================================================================
## Name: ShowRawDataHelp
##
## Description:
##   Pop up the help window related to raw data in the frame archive.
##
## Usage:
##   ShowRawDataHelp
##
## Comments:
##   Called when the user presses the "Help" button at the bottom of the
##   "build raw data request" dialog.

proc ShowRawDataHelp {} {

    ;##- If window already exists, bring it forward
    if {[winfo exists .rawdatahelp]} {
	switch -- [wm state .rawdatahelp] {
	    normal { raise .rawdatahelp; focus .rawdatahelp }
	    withdrawn -
	    iconic { wm deiconify .rawdatahelp; focus .rawdatahelp }
	}
    } else {
	;##- Create a new window
	set tl [NewToplevel .rawdatahelp]
	wm title $tl "Help on building raw data request"
	wm iconname $tl "Raw data requests"

	if {$::winIcons} {
	    ;##- Also create an icon for this window
	    NewToplevel ${tl}Icon -icon -width 48 -height 48 \
		    -highlightthickness 0
	    label ${tl}Icon.bitmap -image helpIcon
	    pack ${tl}Icon.bitmap -side top -fill x
	    wm iconwindow $tl ${tl}Icon
	}

	;##- Create a frame with a text widget and a scrollbar
	frame $tl.msg
	text $tl.msg.text -width 76 -height 16 -wrap word \
		-yscrollcommand "$tl.msg.yscroll set" -setgrid true
	bind $tl.msg.text <Button> "focus %W"
	scrollbar $tl.msg.yscroll -orient vertical \
		-command "$tl.msg.text yview"

	;##- Set up at tag to center the title
	$tl.msg.text tag configure centered -justify center

	;##- Insert the title into the text widget
	$tl.msg.text insert end "\nHelp on building raw data requests\n" \
		centered

	;##- Insert the message into the text widget
	$tl.msg.text insert end {
The "Build Frame Data Request" dialog is used to construct commands to be sent\
to the LDAS frameAPI.  Raw data can be retrieved in a few different ways, and\
in a few different formats.  Output is written to disk file(s), with a message\
stating the filename(s) created.  (guild does not have the capability to\
display time series data.).  The LDAS frameAPI has access to data on disk as\
well as data in the local SAM-QFS tape archive.
	} {} {
Data is accessed according to data type, and time.  (Previously, it was also\
necessary to specify a "detector code", but LDAS has been modified to figure\
that out by itself.)  There is an entry widget to specify the data type; if\
this is left blank, the default data type ("R", for full-rate raw data) will\
be assumed.  Another commonly-used data type is "RDS_R_L1", meaning the\
standard reduced data set.  There is also a "List" button to pop up a window\
with a list of available data\
types; this is not active initially, but becomes active once you click on the\
"Check" button to check the available time range and data types.  Clicking on\
an item in the list in the pop-up window copies that value back into the entry\
widget in the main dialog window.
	} {} {
Times may be specified in GPS seconds\
(or as an arithmetic expression giving GPS seconds, such as\
"630454213-21*60*60"), or as nearly any unambiguous date-time string,\
such as "jan 1 2001" (midnight at the beginning of January 1 in the year\
2001), "Jan 15 5:04" (5:04 on January 15 of the current year),\
"1/19/01 5:15", "19-jan-2001 18:45 cst", "today 3:24pm pdt",\
"now", "now-1000sec", "now -1hour", "now - 3 days", etc. \
Times are assumed to be UTC unless you specify a time zone.  If only a\
start time is specified, data for a one-second time interval will be\
returned.  If start and end times are specified, then either multiple\
one-second files or a single long file will be returned, depending on the\
operation selected (see below).
	} {} {
You can find out the time range for which data is available by pressing\
the "Check" button.  This submits a job to the current LDAS server, and\
when the job finishes, the time range will be displayed to the right of\
the "Check" button (which becomes a "Recheck" button).  Note that the overall\
time range is not the whole story if there are multiple datasets covering\
disjoint time intervals, and does not distinguish between different\
detectors or different data types.  You can pop up a window with complete\
information about the cached data by clicking on the "Details" button.
	} {} {
You must specify a list of channels to be retrieved.  To get a list of\
available channels, press the "List" button to the right of the Channels\
entry widget to submit the appropriate LDAS job.  Double-clicking on a\
channel name in the resulting window causes that channel to be added to the\
list to be retrieved.  Channel names are case-insensitive.
	} {} {
The available operations are as follows:
	}

	;##- Set up a tag to control indentation for the list of operations
	set charwidth [font measure [$tl.msg.text cget -font] X]
	$tl.msg.text tag configure operlist -lmargin2 [expr {28*$charwidth}]

	$tl.msg.text insert end {
  "Get frame data":      Returns one output file for each input file. \
Output can be in frame format, LIGO_LW format (ASCII with XML markup,\
which is readable by humans and by certain viewers),\
or ilwd format (used internally by LDAS).
	} operlist {
  "Get frame elements":  Similar to "Get frame data", but without the frame\
header information and detector location & orientation.  Output format must be\
LIGO_LW or ilwd.
	} operlist {
  "Concatenate frames":  Concatenates all input frames into a single output\
frame covering the full time interval.  Output format must be LIGO_LW or ilwd.
	} operlist


	$tl.msg.text insert end {
For further information about these operations, see\
http://ldas-sw.ligo.caltech.edu/doc/userAPI/html
	} {} {
As you construct the data query, guild calculates\
estimates for the size of the output file(s) and the total time required, and\
displays them just above the \"Submit\" button.  These estimates are\
based on the data collected during the E7 run.  The size estimate should be\
fairly accurate, but the time estimate is just a ballpark figure using rough\
estimates of LDAS processing time and the time required to copy the results\
over the network.  Your results may vary.
	}

	;##- Disable modifications to the text widget
	$tl.msg.text config -state disabled

	;##- Create a "Close" button
	button $tl.close -text "Close" -command "wm withdraw $tl" \
		-default active

	;##- Bind the Return key to the Close button
	bind $tl <Return> "$tl.close invoke"

	;##- Lay out the widgets
	pack $tl.close -side bottom
	grid $tl.msg.text $tl.msg.yscroll -sticky news
	grid rowconfigure $tl.msg 0 -weight 1
	grid columnconfigure $tl.msg 0 -weight 1
	pack $tl.msg -side top -fill both -expand true
    }

    return
}

##=========================================================================
## Name: ShowLdasCmdHelp
##
## Description:
##   Pop up the help window about arbitrary LDAS commands.
##
## Usage:
##   ShowLdasCmdHelp
##
## Comments:
##   Called when the user presses the "Help" button at the bottom of the
##   "LDAS User Command" dialog.

proc ShowLdasCmdHelp {} {

    ;##- If window already exists, bring it forward
    if {[winfo exists .ldascmdhelp]} {
	switch -- [wm state .ldascmdhelp] {
	    normal { raise .ldascmdhelp; focus .ldascmdhelp }
	    withdrawn -
	    iconic { wm deiconify .ldascmdhelp; focus .ldascmdhelp }
	}
    } else {
	;##- Create a new window
	set tl [NewToplevel .ldascmdhelp]
	wm title $tl "Help on submitting LDAS user commands"
	wm iconname $tl "LDAS Commands"

	if {$::winIcons} {
	    ;##- Also create an icon for this window
	    NewToplevel ${tl}Icon -icon -width 48 -height 48 \
		    -highlightthickness 0
	    label ${tl}Icon.bitmap -image helpIcon
	    pack ${tl}Icon.bitmap -side top -fill x
	    wm iconwindow $tl ${tl}Icon
	}

	;##- Create a frame with a text widget and a scrollbar
	frame $tl.msg
	text $tl.msg.text -width 76 -height 16 -wrap word \
		-yscrollcommand "$tl.msg.yscroll set" -setgrid true
	bind $tl.msg.text <Button> "focus %W"
	scrollbar $tl.msg.yscroll -orient vertical \
		-command "$tl.msg.text yview"

	;##- Set up at tag to center the title
	$tl.msg.text tag configure centered -justify center

	;##- Set up a tag for indented text
	set charwidth [font measure [$tl.msg.text cget -font] X]
	$tl.msg.text tag configure indented \
		-lmargin1 [expr {4*$charwidth}] -lmargin2 [expr {4*$charwidth}]

	;##- Insert the title into the text widget
	$tl.msg.text insert end "\nHelp on submitting LDAS user commands\n" \
		centered

	;##- Insert the message into the text widget
	$tl.msg.text insert end {
The "LDAS User Command" dialog provides a way to execute any LDAS user\
command.  (See http://www.ldas-sw.ligo.caltech.edu/doc/userAPI/html\
for available user commands.)  To use this feature, enter just the bare\
LDAS user command into the large text widget; guild adds the initial\
"ldasJob" and the name/password/email information before sending it to the\
LDAS manager.  For instance, to execute a getMetaData command, you would type\
something like:
	} {} {
getMetaData -returnprotocol http:out.xml -outputformat LIGO_LW\
-sqlquery {select tabname from syscat.tables} 
	} indented {
You may use newlines within the command for readability; these will be\
converted to spaces before the command is sent to the LDAS manager.  You may\
also add comments (or comment out undesired parts of the user command)\
using the # character, which causes the rest of the text\
on the line to be ignored.
	} {} {
You can save the currently displayed user command to a file using the\
"Save As..." button.  By convention, these files have an extension of ".job". \
(You could also create these files by hand, if you wanted.)  You can load a\
user command from a .job file using the "Open..." button.
	} {} {
guild allows you to submit a job in one of two ways.  The first is as a\
"foreground" job, in which case a window pops up to display status\
messages (e.g. a message saying that the job has finished and giving the\
location of the output file(s)).  This is generally desirable for short jobs. \
You can have guild automatically download job output, if desired; the\
filename(s) will be chosen by guild, and will be displayed in the job status\
window.  If you quit guild before the job is done, the job will keep running,\
but you will not be notified when it finishes (not even through email), and\
job output will not be downloaded.  However, assuming you kept track of the\
LDAS job ID, you can come back later and do "Get log entries for LDAS job"\
from the "Utilities..." menu to find out whether the job finished successfully\
and/or to get the location of the output.  (Be sure to specify the correct\
LDAS server when getting log entries.)
	} {} {
The second way to submit a job is as a "background" job, in which case status\
messages are sent to the email address you specify.  A window pops up just to\
tell you whether the job started successfully, and to tell you the LDAS job\
ID.  This is generally desirable for long jobs, since you will be notified\
when the job finishes even if you quit guild in the meantime.
	} {} {
You can save your settings (foreground vs. background job, auto-download\
choice, email address, and default directory for job files) from one guild\
session to the next by choosing "Save Settings" under the "File" menu in the\
main guild window.
	} {} {
The "Prev" and "Next" buttons allow you to see the history of jobs you have\
submitted, and to modify and/or resubmit them if desired.  If the job was read\
from a file, that filename will be shown as well.
	}

	;##- Disable modifications to the text widget
	$tl.msg.text config -state disabled

	;##- Create a "Close" button
	button $tl.close -text "Close" -command "wm withdraw $tl" \
		-default active

	;##- Bind the Return key to the Close button
	bind $tl <Return> "$tl.close invoke"

	;##- Lay out the widgets
	pack $tl.close -side bottom
	grid $tl.msg.text $tl.msg.yscroll -sticky news
	grid rowconfigure $tl.msg 0 -weight 1
	grid columnconfigure $tl.msg 0 -weight 1
	pack $tl.msg -side top -fill both -expand true
    }

    return
}

##=========================================================================
## Name: ShowTimeConverterHelp
##
## Description:
##   Pop up the help window related to building database queries.
##
## Usage:
##   ShowTimeConverterHelp
##
## Comments:
##   Called when the user presses the "Help" button at the bottom of a
##   Time Converter window.

proc ShowTimeConverterHelp {} {

    ;##- If window already exists, bring it forward
    if {[winfo exists .timehelp]} {
	switch -- [wm state .timehelp] {
	    normal { raise .timehelp; focus .timehelp }
	    withdrawn -
	    iconic { wm deiconify .timehelp; focus .timehelp }
	}
    } else {
	;##- Create a new window
	set tl [NewToplevel .timehelp]
	wm title $tl "Help on using the Time Converter"
	wm iconname $tl "Metadata queries"

	if {$::winIcons} {
	    ;##- Also create an icon for this window
	    NewToplevel ${tl}Icon -icon -width 48 -height 48 \
		    -highlightthickness 0
	    label ${tl}Icon.bitmap -image helpIcon
	    pack ${tl}Icon.bitmap -side top -fill x
	    wm iconwindow $tl ${tl}Icon
	}

	;##- Create a frame with a text widget and a scrollbar
	frame $tl.msg
	text $tl.msg.text -width 76 -height 16 -wrap word \
		-yscrollcommand "$tl.msg.yscroll set" -setgrid true
	bind $tl.msg.text <Button> "focus %W"
	scrollbar $tl.msg.yscroll -orient vertical \
		-command "$tl.msg.text yview"

	;##- Set up at tag to center the title
	$tl.msg.text tag configure centered -justify center

	;##- Insert the title into the text widget
	$tl.msg.text insert end "\nHow to use the Time Converter\n" centered

	;##- Insert the message into the text widget
	$tl.msg.text insert end {
Simply type a time expression into the entry widget, and see the conversion. \
Times may be specified in GPS seconds, e.g. "674029387", or as an integer arithmetic expression\
giving GPS seconds, such as "630454213-21*60*60". \
Times may also be specified as nearly any unambiguous date-time string,\
such as "jan 1 2001" (midnight at the beginning of January 1 in the year\
2001), "Jan 15 5:04" (5:04 on January 15 of the current year),\
"1/19/01 5:15", "19-jan-2001 18:45 cst", "today 3:24pm pdt",\
"now", "now-1000sec", "NOW -1hour", "now - 3 days", etc. \
("Now" is the current time according to the system clock of the computer\
on which guild is being run.) \
Times are assumed to be UTC unless you specify a time zone.
	}

	;##- Disable modifications to the text widget
	$tl.msg.text config -state disabled

	;##- Create a "Close" button
	button $tl.close -text "Close" -command "wm withdraw $tl" \
		-default active

	;##- Bind the Return key to the Close button
	bind $tl <Return> "$tl.close invoke"

	;##- Lay out the widgets
	pack $tl.close -side bottom
	grid $tl.msg.text $tl.msg.yscroll -sticky news
	grid rowconfigure $tl.msg 0 -weight 1
	grid columnconfigure $tl.msg 0 -weight 1
	pack $tl.msg -side top -fill both -expand true
    }

    return
}

##=========================================================================
## Name: CompareVersions
##
## Description:
##   Routine to compare version numbers, since neither lexical nor
##   real-number sorting is quite correct (e.g. 2.12 is later than 2.6y)
##
## Usage:
##   CompareVersions ver1 comparison ver2
##
## Comments:
##   Currently, comparison can be < or >.
##   A version of "no_file" is treated as being later than any ordinary
##   version.

proc CompareVersions { ver1 comparison ver2 } {

    switch -- $comparison {
	"<" {
	    set a $ver1
	    set b $ver2
	}
	">" {
	    set a $ver2
	    set b $ver1
	}
	default {
	    bgerror "Error in CompareVersions: invalid comparison $comparison\
		    (expression was $ver1 $comparison $ver2)"
	    exit
	}
    }

    if { [regexp -- {(\d+)\.(\d+)\.(\d+)} $a match a1num a2num a3num] } {
    } elseif { [regexp -- {(\d+)\.(\d+)(\D+)} $a match a1num a2num a3lex]} {
    } elseif { [regexp -- {(\d+)\.(\d+)} $a match a1num a2num] } {
    } elseif { $a == "no_file" } {
	return 0
    } else {
	bgerror "Error in CompareVersions: unrecognized version format $a\
		(expression was $ver1 $comparison $ver2)"
	exit
    }

    if { [regexp -- {(\d+)\.(\d+)\.(\d+)} $b match b1num b2num b3num] } {
    } elseif { [regexp -- {(\d+)\.(\d+)(\D+)} $b match b1num b2num b3lex]} {
    } elseif { [regexp -- {(\d+)\.(\d+)} $b match b1num b2num] } {
    } elseif { $b == "no_file" } {
	return 1
    } else {
	bgerror "Error in CompareVersions: unrecognized version format $b\
		(expression was $ver1 $comparison $ver2)"
	exit
    }

    ;##- Now do the comparison.  b is supposed to be later than a.
    if { $b1num > $a1num } { return 1 }
    if { $b1num < $a1num } { return 0 }

    if { $b2num > $a2num } { return 1 }
    if { $b2num < $a2num } { return 0 }

    ;##- Any number supersedes any lexical
    if { [info exists b3num] } {
	if { [info exists a3num] } {
	    if { $b3num > $a3num } {
		return 1
	    } else {
		return 0
	    }
	} else {
	    return 1
	}
    } elseif { [info exists b3lex] } {
	if { [info exists a3num] } {
	    return 0
	} elseif { [info exists a3lex] } {
	    if { [string compare -nocase $b3lex $a3lex] == 1 } {
		return 1
	    } else {
		return 0
	    }
	} else {
	    return 1
	}
    }

    ;##- If we get here, the two versions are equal
    return 0
}


##=========================================================================
## Name: Iconbmp_guild
##
## Description:
##   Returns a text string containing a bitmap to use for an icon.
##
## Parameters:
##   none
##
## Usage:
##   image create bitmap guildIcon -data [Iconbmp_guild]
##
## Comments:
##   Bitmap was generated by hand using the "bitmap" utility, then pasted
##   into this routine.  Note that the "#define" sequences are not Tcl
##   comments because they occur inside braces, not where a command can start.

proc Iconbmp_guild {} {
    return {
#define icon_guild_width 46
#define icon_guild_height 48
static unsigned char icon_guild_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x8c, 0x01, 0x30, 0x00, 0x00, 0x00, 0x8c, 0x01, 0x30,
   0x00, 0x00, 0x00, 0x8c, 0x01, 0x30, 0x00, 0x00, 0x00, 0x80, 0x01, 0x30,
   0x00, 0x00, 0x00, 0x80, 0x01, 0x30, 0xf8, 0x66, 0x60, 0x8c, 0xc1, 0x37,
   0xfc, 0x67, 0x60, 0x8c, 0xe1, 0x3f, 0x06, 0x67, 0x60, 0x8c, 0x31, 0x38,
   0x06, 0x67, 0x60, 0x8c, 0x31, 0x38, 0x03, 0x66, 0x60, 0x8c, 0x19, 0x30,
   0x03, 0x66, 0x60, 0x8c, 0x19, 0x30, 0x03, 0x66, 0x60, 0x8c, 0x19, 0x30,
   0x03, 0x66, 0x60, 0x8c, 0x19, 0x30, 0x03, 0x66, 0x60, 0x8c, 0x19, 0x30,
   0x06, 0x67, 0x70, 0x8c, 0x31, 0x38, 0x06, 0xc7, 0x78, 0x8c, 0x31, 0x38,
   0xfc, 0xc7, 0x6f, 0x8c, 0xe1, 0x3f, 0xf8, 0x86, 0x67, 0x8c, 0xc1, 0x37,
   0x00, 0x06, 0x00, 0x00, 0x00, 0x00, 0x03, 0x06, 0x00, 0x00, 0x00, 0x00,
   0x06, 0x03, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x01, 0x00, 0x00, 0x00, 0x00,
   0xf8, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
    }
}

##=========================================================================
## Name: Iconbmp_buildquery
##
## Description:
##   Returns a text string containing a bitmap to use for an icon.
##
## Parameters:
##   none
##
## Usage:
##   image create bitmap buildqueryIcon -data [Iconbmp_buildquery]
##
## Comments:
##   Bitmap was generated by hand using the "bitmap" utility, then pasted
##   into this routine.  Note that the "#define" sequences are not Tcl
##   comments because they occur inside braces, not where a command can start.

proc Iconbmp_buildquery {} {
    return {
#define icon_buildquery_width 46
#define icon_buildquery_height 48
static unsigned char icon_buildquery_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x18, 0x00, 0x00, 0xc6, 0x00, 0x06, 0x18, 0x00, 0x00, 0xc6, 0x00, 0x06,
   0x18, 0x00, 0x00, 0xc0, 0x00, 0x06, 0x18, 0x00, 0x00, 0xc0, 0x00, 0x06,
   0xd8, 0xc1, 0x30, 0xc6, 0xe0, 0x06, 0xf8, 0xc7, 0x30, 0xc6, 0xf0, 0x07,
   0x38, 0xc6, 0x30, 0xc6, 0x18, 0x07, 0x38, 0xce, 0x30, 0xc6, 0x18, 0x07,
   0x18, 0xcc, 0x30, 0xc6, 0x0c, 0x06, 0x18, 0xcc, 0x30, 0xc6, 0x0c, 0x06,
   0x18, 0xcc, 0x30, 0xc6, 0x0c, 0x06, 0x18, 0xcc, 0x30, 0xc6, 0x0c, 0x06,
   0x38, 0xce, 0x30, 0xc6, 0x18, 0x07, 0x38, 0x86, 0x39, 0xc6, 0x18, 0x07,
   0xf8, 0x87, 0x3f, 0xc6, 0xf0, 0x07, 0xd8, 0x01, 0x37, 0xc6, 0xe0, 0x06,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0xb8, 0x0d, 0xc3, 0xc3, 0x6c, 0x30, 0xfc, 0x0d, 0xe3, 0xc7, 0x6e, 0x30,
   0xc6, 0x0d, 0x33, 0xcc, 0x63, 0x18, 0xc6, 0x0d, 0x33, 0xcc, 0xc1, 0x18,
   0x83, 0x0d, 0x1b, 0xd8, 0xc0, 0x18, 0x83, 0x0d, 0xfb, 0xdf, 0xc0, 0x0c,
   0x83, 0x0d, 0xfb, 0xdf, 0x80, 0x0d, 0x83, 0x0d, 0x1b, 0xc0, 0x80, 0x0d,
   0xc6, 0x0d, 0x33, 0xd8, 0x80, 0x07, 0xc6, 0x99, 0x33, 0xcc, 0x00, 0x07,
   0xfc, 0xf9, 0xe3, 0xcf, 0x00, 0x07, 0xb8, 0x71, 0xc3, 0xc3, 0x00, 0x03,
   0x80, 0x01, 0x00, 0x00, 0x00, 0x03, 0x80, 0x01, 0x00, 0x00, 0x00, 0x03,
   0x80, 0x01, 0x00, 0x00, 0xe0, 0x01, 0x80, 0x01, 0x00, 0x00, 0xe0, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
    }
}

##=========================================================================
## Name: Iconbmp_sql
##
## Description:
##   Returns a text string containing a bitmap to use for an icon.
##
## Parameters:
##   none
##
## Usage:
##   image create bitmap sqlIcon -data [Iconbmp_sql]
##
## Comments:
##   Bitmap was generated by hand using the "bitmap" utility, then pasted
##   into this routine.  Note that the "#define" sequences are not Tcl
##   comments because they occur inside braces, not where a command can start.

proc Iconbmp_sql {} {
    return {
#define icon_SQL_smaller_width 46
#define icon_SQL_smaller_height 48
static unsigned char icon_SQL_smaller_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0xe0, 0x0f, 0xc0, 0x07, 0x18, 0x00, 0xf8, 0x3f, 0xf0, 0x1f, 0x18, 0x00,
   0x18, 0x30, 0x38, 0x38, 0x18, 0x00, 0x0c, 0x60, 0x0c, 0x60, 0x18, 0x00,
   0x0c, 0x00, 0x0c, 0x60, 0x18, 0x00, 0x0c, 0x00, 0x0c, 0x60, 0x18, 0x00,
   0x38, 0x00, 0x06, 0xc0, 0x18, 0x00, 0xf0, 0x07, 0x06, 0xc0, 0x18, 0x00,
   0xc0, 0x1f, 0x06, 0xc0, 0x18, 0x00, 0x00, 0x38, 0x06, 0xc0, 0x18, 0x00,
   0x00, 0x60, 0x0c, 0x62, 0x18, 0x00, 0x00, 0x60, 0x0c, 0x67, 0x18, 0x00,
   0x0c, 0x60, 0x0c, 0x6e, 0x18, 0x00, 0x18, 0x30, 0x38, 0x3c, 0x18, 0x00,
   0xf8, 0x3f, 0xf0, 0x7f, 0xf8, 0x1f, 0xe0, 0x0f, 0xc0, 0xe7, 0xf8, 0x1f,
   0x00, 0x00, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
    }
}

##=========================================================================
## Name: Iconbmp_ldascmd
##
## Description:
##   Returns a text string containing a bitmap to use for an icon.
##
## Parameters:
##   none
##
## Usage:
##   image create bitmap ldascmdIcon -data [Iconbmp_ldascmd]
##
## Comments:
##   Bitmap was generated by hand using the "bitmap" utility, then pasted
##   into this routine.  Note that the "#define" sequences are not Tcl
##   comments because they occur inside braces, not where a command can start.

proc Iconbmp_ldascmd {} {
    return {
#define icon_LDAScmd_width 46
#define icon_LDAScmd_height 48
static unsigned char icon_LDAScmd_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x06, 0xf8, 0x01, 0x0c, 0xe0, 0x01, 0x06, 0xf8, 0x07, 0x0c, 0xf8, 0x07,
   0x06, 0x18, 0x06, 0x1e, 0x18, 0x06, 0x06, 0x18, 0x0c, 0x1e, 0x0c, 0x0c,
   0x06, 0x18, 0x0c, 0x33, 0x0c, 0x00, 0x06, 0x18, 0x0c, 0x33, 0x1c, 0x00,
   0x06, 0x18, 0x0c, 0x33, 0xf8, 0x01, 0x06, 0x18, 0x8c, 0x61, 0xe0, 0x07,
   0x06, 0x18, 0x8c, 0x7f, 0x00, 0x0e, 0x06, 0x18, 0x8c, 0x7f, 0x00, 0x0c,
   0x06, 0x18, 0xcc, 0xc0, 0x0c, 0x0c, 0x06, 0x18, 0xc6, 0xc0, 0x18, 0x06,
   0xfe, 0xf9, 0xc7, 0xc0, 0xf8, 0x07, 0xfe, 0xf9, 0xc1, 0xc0, 0xe0, 0x01,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x38, 0x4e, 0x14, 0x11, 0xd1, 0x01,
   0x44, 0xd1, 0xb6, 0x29, 0x53, 0x02, 0x04, 0x51, 0x55, 0x45, 0x55, 0x04,
   0x04, 0x51, 0x55, 0x45, 0x59, 0x04, 0x04, 0x51, 0x14, 0x7d, 0x51, 0x04,
   0x44, 0x51, 0x14, 0x45, 0x51, 0x02, 0x38, 0x4e, 0x14, 0x45, 0xd1, 0x01,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
    }
}

##=========================================================================
## Name: Iconbmp_list
##
## Description:
##   Returns a text string containing a bitmap to use for an icon.
##
## Parameters:
##   none
##
## Usage:
##   image create bitmap listIcon -data [Iconbmp_list]
##
## Comments:
##   Bitmap was generated by hand using the "bitmap" utility, then pasted
##   into this routine.  Note that the "#define" sequences are not Tcl
##   comments because they occur inside braces, not where a command can start.

proc Iconbmp_list {} {
    return {
#define icon_list_width 46
#define icon_list_height 48
static unsigned char icon_list_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x63, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x63, 0x00, 0x00, 0x00, 0x00, 0x00, 0x63, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x03, 0x00, 0x00, 0x0c, 0x00, 0x00, 0x03, 0x00, 0x00, 0x0c, 0x00,
   0x00, 0x03, 0x00, 0x00, 0x0c, 0x00, 0x00, 0x63, 0xe0, 0x07, 0x3f, 0x00,
   0x00, 0x63, 0xf8, 0x1f, 0x3f, 0x00, 0x00, 0x63, 0x1c, 0x38, 0x0c, 0x00,
   0x00, 0x63, 0x0c, 0x30, 0x0c, 0x00, 0x00, 0x63, 0x0c, 0x00, 0x0c, 0x00,
   0x00, 0x63, 0x1c, 0x00, 0x0c, 0x00, 0x00, 0x63, 0xf8, 0x07, 0x0c, 0x00,
   0x00, 0x63, 0xe0, 0x1f, 0x0c, 0x00, 0x00, 0x63, 0x00, 0x38, 0x0c, 0x00,
   0x00, 0x63, 0x00, 0x30, 0x0c, 0x00, 0x00, 0x63, 0x0c, 0x30, 0x0c, 0x00,
   0x00, 0x63, 0x1c, 0x38, 0x0c, 0x00, 0x00, 0x63, 0xf8, 0x1f, 0x3c, 0x00,
   0x00, 0x63, 0xe0, 0x07, 0x38, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
    }
}

##=========================================================================
## Name: Iconbmp_job
##
## Description:
##   Returns a text string containing a bitmap to use for an icon.
##
## Parameters:
##   none
##
## Usage:
##   image create bitmap jobIcon -data [Iconbmp_job]
##
## Comments:
##   Bitmap was generated by hand using the "bitmap" utility, then pasted
##   into this routine.  Note that the "#define" sequences are not Tcl
##   comments because they occur inside braces, not where a command can start.

proc Iconbmp_job {} {
    return {
#define icon_job_width 38
#define icon_job_height 40
static unsigned char icon_job_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x03, 0x00, 0x80, 0x01, 0x00,
   0x03, 0x00, 0x80, 0x01, 0x00, 0x03, 0x00, 0x00, 0x00, 0x00, 0x03, 0x00,
   0x00, 0x00, 0x00, 0x03, 0x00, 0x80, 0xc1, 0x07, 0xfb, 0x00, 0x80, 0xe1,
   0x0f, 0xff, 0x01, 0x80, 0x31, 0x18, 0x07, 0x03, 0x80, 0x31, 0x18, 0x07,
   0x03, 0x80, 0x19, 0x30, 0x03, 0x06, 0x80, 0x19, 0x30, 0x03, 0x06, 0x80,
   0x19, 0x30, 0x03, 0x06, 0x80, 0x19, 0x30, 0x03, 0x06, 0x80, 0x19, 0x30,
   0x03, 0x06, 0x80, 0x31, 0x18, 0x07, 0x03, 0x80, 0x31, 0x18, 0x07, 0x03,
   0x80, 0xe1, 0x0f, 0xff, 0x01, 0x80, 0xc1, 0x07, 0xfb, 0x00, 0x80, 0x01,
   0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00,
   0x00, 0x78, 0x00, 0x00, 0x00, 0x00, 0x38, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
    }
}

##=========================================================================
## Name: Iconbmp_jobs
##
## Description:
##   Returns a text string containing a bitmap to use for an icon.
##
## Parameters:
##   none
##
## Usage:
##   image create bitmap jobsIcon -data [Iconbmp_jobs]
##
## Comments:
##   Bitmap was generated by hand using the "bitmap" utility, then pasted
##   into this routine.  Note that the "#define" sequences are not Tcl
##   comments because they occur inside braces, not where a command can start.

proc Iconbmp_jobs {} {
    return {
#define jobsIcon_width 46
#define jobsIcon_height 48
static unsigned char jobsIcon_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x60, 0x00, 0xc0, 0x00, 0x00, 0x00, 0x60, 0x00, 0xc0, 0x00, 0x00, 0x00,
   0x60, 0x00, 0xc0, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00,
   0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0x60, 0xf0, 0xc1, 0x3e, 0xe0, 0x07,
   0x60, 0xf8, 0xc3, 0x7f, 0xf0, 0x0f, 0x60, 0x0c, 0xc6, 0xc1, 0x18, 0x18,
   0x60, 0x0c, 0xc6, 0xc1, 0x18, 0x00, 0x60, 0x06, 0xcc, 0x80, 0x19, 0x00,
   0x60, 0x06, 0xcc, 0x80, 0xf1, 0x07, 0x60, 0x06, 0xcc, 0x80, 0xe1, 0x0f,
   0x60, 0x06, 0xcc, 0x80, 0x01, 0x18, 0x60, 0x06, 0xcc, 0x80, 0x01, 0x18,
   0x60, 0x0e, 0xc6, 0xc1, 0x00, 0x18, 0x60, 0x0c, 0xc6, 0xc1, 0x18, 0x18,
   0x60, 0xf8, 0xc3, 0x7f, 0xf0, 0x0f, 0x60, 0xf0, 0xc1, 0x3e, 0xe0, 0x07,
   0x60, 0x00, 0x00, 0x00, 0x00, 0x00, 0x60, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x30, 0x00, 0x00, 0x00, 0x00, 0x00, 0x1e, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x0e, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
    }
}

##=========================================================================
## Name: Iconbmp_table
##
## Description:
##   Returns a text string containing a bitmap to use for an icon.
##
## Parameters:
##   none
##
## Usage:
##   image create bitmap tableIcon -data [Iconbmp_table]
##
## Comments:
##   Bitmap was generated by hand using the "bitmap" utility, then pasted
##   into this routine.  Note that the "#define" sequences are not Tcl
##   comments because they occur inside braces, not where a command can start.

proc Iconbmp_table {} {
    return {
#define icon_table_width 46
#define icon_table_height 48
static unsigned char icon_table_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x30, 0x00, 0x03, 0x00, 0x00, 0x00, 0x30, 0x00, 0x03, 0x00,
   0x0c, 0x00, 0x30, 0x00, 0x03, 0x00, 0x0c, 0x00, 0x30, 0x00, 0x03, 0x00,
   0x0c, 0x00, 0x30, 0x00, 0x03, 0x00, 0x3f, 0x78, 0xb0, 0x07, 0x83, 0x07,
   0x3f, 0xfe, 0xf1, 0x0f, 0xc3, 0x0f, 0x0c, 0x87, 0x71, 0x18, 0x63, 0x18,
   0x0c, 0x03, 0x73, 0x18, 0x63, 0x18, 0x0c, 0x00, 0x33, 0x30, 0x33, 0x30,
   0x0c, 0xf8, 0x33, 0x30, 0xf3, 0x3f, 0x0c, 0xfe, 0x33, 0x30, 0xf3, 0x3f,
   0x0c, 0x07, 0x33, 0x30, 0x33, 0x00, 0x0c, 0x03, 0x33, 0x30, 0x33, 0x00,
   0x0c, 0x03, 0x73, 0x18, 0x63, 0x30, 0x0c, 0x83, 0x73, 0x18, 0x63, 0x18,
   0x3c, 0xfe, 0xf7, 0x0f, 0xc3, 0x1f, 0x38, 0x7c, 0xb6, 0x07, 0x83, 0x07,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
    }
}

##=========================================================================
## Name: Iconbmp_time
##
## Description:
##   Returns a text string containing a bitmap to use for an icon.
##
## Parameters:
##   none
##
## Usage:
##   image create bitmap timeIcon -data [Iconbmp_time]
##
## Comments:
##   Bitmap was generated by hand using the "bitmap" utility, then pasted
##   into this routine.  Note that the "#define" sequences are not Tcl
##   comments because they occur inside braces, not where a command can start.

proc Iconbmp_time {} {
    return {
#define icon_GPS_UTC_width 46
#define icon_GPS_UTC_height 48
static unsigned char icon_GPS_UTC_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0f, 0xfc, 0x03, 0xfc, 0x00,
   0xc0, 0x3f, 0xfc, 0x0f, 0xff, 0x03, 0xe0, 0x70, 0x0c, 0x0c, 0x03, 0x03,
   0x30, 0xc0, 0x0c, 0x98, 0x01, 0x06, 0x30, 0xc0, 0x0c, 0x98, 0x01, 0x06,
   0x30, 0x00, 0x0c, 0x98, 0x01, 0x00, 0x18, 0x00, 0x0c, 0x0c, 0x07, 0x00,
   0x18, 0xfc, 0xfc, 0x0f, 0x7e, 0x00, 0x18, 0xfc, 0xfc, 0x03, 0xf8, 0x01,
   0x18, 0xc0, 0x0c, 0x00, 0x80, 0x03, 0x30, 0xc0, 0x0c, 0x00, 0x00, 0x06,
   0x30, 0xc0, 0x0c, 0x80, 0x01, 0x06, 0x30, 0xe0, 0x0c, 0x80, 0x01, 0x06,
   0xe0, 0xf0, 0x0c, 0x00, 0x03, 0x03, 0xc0, 0xff, 0x0c, 0x00, 0xff, 0x03,
   0x00, 0xcf, 0x0c, 0x00, 0xfc, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x08, 0x04, 0x00, 0x00,
   0x00, 0x00, 0x1c, 0x04, 0x00, 0x00, 0x00, 0x00, 0x3e, 0x04, 0x00, 0x00,
   0x00, 0x00, 0x7f, 0x04, 0x00, 0x00, 0x00, 0x00, 0x08, 0x04, 0x00, 0x00,
   0x00, 0x00, 0x08, 0x04, 0x00, 0x00, 0x00, 0x00, 0x88, 0x3f, 0x00, 0x00,
   0x00, 0x00, 0x08, 0x1f, 0x00, 0x00, 0x00, 0x00, 0x08, 0x0e, 0x00, 0x00,
   0x00, 0x00, 0x08, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x18, 0x60, 0xfe, 0x1f, 0x78, 0x00,
   0x18, 0x60, 0xfe, 0x1f, 0xfe, 0x01, 0x18, 0x60, 0xc0, 0x00, 0x87, 0x03,
   0x18, 0x60, 0xc0, 0x80, 0x01, 0x06, 0x18, 0x60, 0xc0, 0x80, 0x01, 0x06,
   0x18, 0x60, 0xc0, 0x80, 0x01, 0x00, 0x18, 0x60, 0xc0, 0xc0, 0x00, 0x00,
   0x18, 0x60, 0xc0, 0xc0, 0x00, 0x00, 0x18, 0x60, 0xc0, 0xc0, 0x00, 0x00,
   0x18, 0x60, 0xc0, 0xc0, 0x00, 0x00, 0x18, 0x60, 0xc0, 0x80, 0x01, 0x00,
   0x18, 0x60, 0xc0, 0x80, 0x01, 0x06, 0x30, 0x30, 0xc0, 0x80, 0x01, 0x06,
   0x70, 0x38, 0xc0, 0x00, 0x87, 0x03, 0xe0, 0x1f, 0xc0, 0x00, 0xfe, 0x01,
   0x80, 0x07, 0xc0, 0x00, 0x78, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
    }
}

##=========================================================================
## Name: Iconbmp_help
##
## Description:
##   Returns a text string containing a bitmap to use for an icon.
##
## Parameters:
##   none
##
## Usage:
##   image create bitmap helpIcon -data [Iconbmp_help]
##
## Comments:
##   Bitmap was generated by hand using the "bitmap" utility, then pasted
##   into this routine.  Note that the "#define" sequences are not Tcl
##   comments because they occur inside braces, not where a command can start.

proc Iconbmp_help {} {
    return {
#define icon_help_width 46
#define icon_help_height 48
static unsigned char icon_help_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x0c, 0x00, 0x00, 0x30, 0x00, 0x00, 0x0c, 0x00, 0x00, 0x30, 0x00, 0x00,
   0x0c, 0x00, 0x00, 0x30, 0x00, 0x00, 0x0c, 0x00, 0x00, 0x30, 0x00, 0x00,
   0x0c, 0x00, 0x00, 0x30, 0x00, 0x00, 0xcc, 0x03, 0x7c, 0x30, 0xf6, 0x01,
   0xec, 0x0f, 0xfe, 0x30, 0xfe, 0x03, 0x3c, 0x0c, 0x83, 0x31, 0x0e, 0x06,
   0x1c, 0x18, 0x83, 0x31, 0x0e, 0x06, 0x0c, 0x98, 0x01, 0x33, 0x06, 0x0c,
   0x0c, 0x98, 0xff, 0x33, 0x06, 0x0c, 0x0c, 0x98, 0xff, 0x33, 0x06, 0x0c,
   0x0c, 0x98, 0x01, 0x30, 0x06, 0x0c, 0x0c, 0x98, 0x01, 0x30, 0x06, 0x0c,
   0x0c, 0x18, 0x03, 0x33, 0x0e, 0x06, 0x0c, 0x18, 0x83, 0x31, 0x0e, 0x06,
   0x0c, 0x18, 0xfe, 0x31, 0xfe, 0x03, 0x0c, 0x18, 0x7c, 0x30, 0xf6, 0x01,
   0x00, 0x00, 0x00, 0x00, 0x06, 0x00, 0x00, 0x00, 0x00, 0x00, 0x06, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x06, 0x00, 0x00, 0x00, 0x00, 0x00, 0x06, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x06, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
    }
}

##=========================================================================
## Name: Iconbmp_info
##
## Description:
##   Returns a text string containing a bitmap to use for an icon.
##
## Parameters:
##   none
##
## Usage:
##   image create bitmap infoIcon -data [Iconbmp_info]
##
## Comments:
##   Bitmap was generated by hand using the "bitmap" utility, then pasted
##   into this routine.  Note that the "#define" sequences are not Tcl
##   comments because they occur inside braces, not where a command can start.

proc Iconbmp_info {} {
    return {
#define icon_info_width 46
#define icon_info_height 48
static unsigned char icon_info_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x60, 0x00, 0x00, 0x0e, 0x00, 0x00, 0x60, 0x00, 0x00, 0x0f, 0x00, 0x00,
   0x60, 0x00, 0x00, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x03, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x03, 0x00, 0x00, 0x60, 0xcc, 0xc1, 0x0f, 0x3e, 0x00,
   0x60, 0xec, 0xc7, 0x0f, 0x7f, 0x00, 0x60, 0x3c, 0x06, 0x83, 0xc1, 0x00,
   0x60, 0x1c, 0x0c, 0x83, 0xc1, 0x00, 0x60, 0x0c, 0x0c, 0xc3, 0x80, 0x01,
   0x60, 0x0c, 0x0c, 0xc3, 0x80, 0x01, 0x60, 0x0c, 0x0c, 0xc3, 0x80, 0x01,
   0x60, 0x0c, 0x0c, 0xc3, 0x80, 0x01, 0x60, 0x0c, 0x0c, 0xc3, 0x80, 0x01,
   0x60, 0x0c, 0x0c, 0x83, 0xc1, 0x00, 0x60, 0x0c, 0x0c, 0x83, 0xc1, 0x00,
   0x60, 0x0c, 0x0c, 0x03, 0x7f, 0x00, 0x60, 0x0c, 0x0c, 0x03, 0x3e, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
    }
}


##=========================================================================
## Name: Htmlbmp_ball
##
## Description:
##   Returns a text string containing a bitmap for the colored "balls"
##   in LDAS log files.
##
## Parameters:
##   none
##
## Usage:
##   image create bitmap greenball -data [Htmlbmp_ball] \
##       -maskdata [Htmlbmp_ballmask] -foreground black -background green
##
## Comments:
##   Bitmap was generated by hand using the "bitmap" utility, then pasted
##   into this routine.  Note that the "#define" sequences are not Tcl
##   comments because they occur inside braces, not where a command can start.

proc Htmlbmp_ball {} {
    return {
#define ball12_width 12
#define ball12_height 12
static unsigned char ball12_bits[] = {
   0xf0, 0x00, 0x0c, 0x03, 0x02, 0x04, 0x02, 0x04, 0x01, 0x08, 0x01, 0x08,
   0x01, 0x08, 0x01, 0x08, 0x02, 0x04, 0x02, 0x04, 0x0c, 0x03, 0xf0, 0x00};
    }
}


##=========================================================================
## Name: Htmlbmp_ballmask
##
## Description:
##   Returns a text string containing a mask bitmap for the colored "balls"
##   in LDAS log files.
##
## Parameters:
##   none
##
## Usage:
##   image create bitmap greenball -data [Htmlbmp_ball] \
##       -maskdata [Htmlbmp_ballmask] -foreground black -background green
##
## Comments:
##   Bitmap was generated by hand using the "bitmap" utility, then pasted
##   into this routine.  Note that the "#define" sequences are not Tcl
##   comments because they occur inside braces, not where a command can start.

proc Htmlbmp_ballmask {} {
    return {
#define ball12mask_width 12
#define ball12mask_height 12
static unsigned char ball12mask_bits[] = {
   0xf0, 0x00, 0xfc, 0x03, 0xfe, 0x07, 0xfe, 0x07, 0xff, 0x0f, 0xff, 0x0f,
   0xff, 0x0f, 0xff, 0x0f, 0xfe, 0x07, 0xfe, 0x07, 0xfc, 0x03, 0xf0, 0x00};
    }
}


##=========================================================================
## Name: Htmlbmp_envelope
##
## Description:
##   Returns a text string containing a bitmap for the "envelope" gifs
##   in LDAS log files.
##
## Parameters:
##   none
##
## Usage:
##   image create bitmap envelope -data [Htmlbmp_envelope] \
##       -maskdata [Htmlbmp_envelopemask] -foreground black -background white
##
## Comments:
##   Bitmap was generated by hand using the "bitmap" utility, then pasted
##   into this routine.  Note that the "#define" sequences are not Tcl
##   comments because they occur inside braces, not where a command can start.

proc Htmlbmp_envelope {} {
    return {
#define envelope_width 20
#define envelope_height 12
static unsigned char envelope_bits[] = {
   0xff, 0xff, 0x0f, 0x07, 0x00, 0x0e, 0x19, 0x80, 0x09, 0x61, 0x60, 0x08,
   0x81, 0x19, 0x08, 0x41, 0x26, 0x08, 0x21, 0x40, 0x08, 0x11, 0x80, 0x08,
   0x09, 0x00, 0x09, 0x05, 0x00, 0x0a, 0x03, 0x00, 0x0c, 0xff, 0xff, 0x0f};
    }
}


##=========================================================================
## Name: Htmlbmp_envelopemask
##
## Description:
##   Returns a text string containing a mask bitmap for the "envelope" gifs
##   in LDAS log files.
##
## Parameters:
##   none
##
## Usage:
##   image create bitmap envelope -data [Htmlbmp_envelope] \
##       -maskdata [Htmlbmp_envelopemask] -foreground black -background white
##
## Comments:
##   Bitmap was generated by hand using the "bitmap" utility, then pasted
##   into this routine.  Note that the "#define" sequences are not Tcl
##   comments because they occur inside braces, not where a command can start.

proc Htmlbmp_envelopemask {} {
    return {
#define envelopemask_width 20
#define envelopemask_height 12
static unsigned char envelopemask_bits[] = {
   0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,
   0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,
   0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff};
    }
}


##=========================================================================
## Name: Htmlbmp_telephone
##
## Description:
##   Returns a text string containing a bitmap for the colored "telephone" gifs
##   in LDAS log files.
##
## Parameters:
##   none
##
## Usage:
##   image create bitmap telephone -data [Htmlbmp_telephone] \
##       -maskdata [Htmlbmp_telephonemask] -foreground black -background red
##
## Comments:
##   Bitmap was generated by hand using the "bitmap" utility, then pasted
##   into this routine.  Note that the "#define" sequences are not Tcl
##   comments because they occur inside braces, not where a command can start.

proc Htmlbmp_telephone {} {
    return {
#define telephone_width 16
#define telephone_height 12
static unsigned char telephone_bits[] = {
   0xfc, 0x3f, 0x02, 0x40, 0xf1, 0x8f, 0x29, 0x94, 0xef, 0xf7, 0x20, 0x04,
   0x10, 0x08, 0x90, 0x09, 0x88, 0x11, 0x88, 0x11, 0x04, 0x20, 0xfc, 0x3f};
    }
}


##=========================================================================
## Name: Htmlbmp_telephonemask
##
## Description:
##   Returns a text string containing a mask bitmap for the colored
##   "telephone" gifs in LDAS log files.
##
## Parameters:
##   none
##
## Usage:
##   image create bitmap telephone -data [Htmlbmp_telephone] \
##       -maskdata [Htmlbmp_telephonemask] -foreground black -background red
##
## Comments:
##   Bitmap was generated by hand using the "bitmap" utility, then pasted
##   into this routine.  Note that the "#define" sequences are not Tcl
##   comments because they occur inside braces, not where a command can start.

proc Htmlbmp_telephonemask {} {
    return {
#define telephonemask_width 16
#define telephonemask_height 12
static unsigned char telephonemask_bits[] = {
   0xfc, 0x3f, 0xfe, 0x7f, 0xff, 0xff, 0xef, 0xf7, 0xef, 0xf7, 0xe0, 0x07,
   0xf0, 0x0f, 0xf0, 0x0f, 0xf8, 0x1f, 0xf8, 0x1f, 0xfc, 0x3f, 0xfc, 0x3f};
    }
}


##=========================================================================
## Name: NewToplevel
##

proc NewToplevel { {name ""} args } {

    ;##- If the "-icon" switch was specified, strip it out of the argument
    ;##- list (since it's not a valid argument to the Tk toplevel command)
    set iicon [lsearch -exact $args "-icon"]
    if { $iicon > -1 } {
	set args [lreplace $args $iicon $iicon]
    }

    if { $name == "." } {
	set tl "."
    } else {

	if { $name == "" } {
	    ;##- Choose a unique name, using a counter
	    if { ! [info exists ::toplevelCounter] } {
		;##- Initialize counter for constructing toplevel window names
		set ::toplevelCounter 0
	    }
	    incr ::toplevelCounter
	    set name ".tl$::toplevelCounter"
	}

	set tl [eval toplevel $name $args]

    }

    ;##- If we're dealing with an icon, just return now
    if { $iicon > -1 } { return }

    ;##- Add this window name to the stack
    if { ! [info exists ::windowStack] } { set ::windowStack {} }
    lappend ::windowStack $name

    ;##- Set up bindings to keep track of the stacking order
    bind $tl <FocusIn> [ selsub {
	if { "%W" == "$tl" } {
	    set i [lsearch -exact $::windowStack $tl]
	    if { $i > -1 } {
		set ::windowStack [concat [lreplace $::windowStack $i $i] $tl]
	    }

	    if {[info exists ::errorWindow] && [winfo exists $::errorWindow]} {
		switch -- [wm state $::errorWindow] {
		    normal { raise $::errorWindow; focus $::errorWindow }
		    withdrawn -
		    iconic {wm deiconify $::errorWindow; focus $::errorWindow}
		}		
	    }

	}
    } tl ]

    bind $tl <Destroy> [ selsub {
	if { "%W" == "$tl" } {
	    set i [lsearch -exact $::windowStack $tl]
	    if { $i > 0 } {
		set ::windowStack [lreplace $::windowStack $i $i]
	    }

	    if { [info exists ::errorWindow] && "%W" == $::errorWindow } {
		unset ::errorWindow
	    }
	}
    } tl ]

    return $tl
}


##=========================================================================
## Name: GeturlWhole
##
## Description:
##   Layer on top of http::geturl which tries to ensure that the whole
##   file is available before trying to download it.
##
## Usage:
##   GeturlWhole url ?options?
##
## Comments:
##   Checks the file size once per second until it gets two readings which
##   are the same, then initiates the file transfer.  Finally, re-checks to
##   make sure the file size is still consistent.  Yuck!

proc GeturlWhole { url args } {
###    puts "In GeturlWhole, url is $url"

    set lastsize -2
    set cursize -1
    set repx4096 0
    set nloop 0

    while { $cursize != $lastsize || $repx4096 < 10 } {

	set error ""

	incr nloop
	;##- PSS Hack: this timeout doesn't do an appropriate thing,
	;##- partly because Apache seems not to report the sizes of
        ;##- text files, so for now, set the loop limit very high
	if { $nloop > 100 } {
	    set error "timeout waiting for file"
	}

	set lastsize $cursize
	set cursize 0
	if {[catch {eval http::geturl $url -validate 1} httpvar]} {
	    set error $httpvar
	}

	if { ! [string is space $error] } {
	    ;##- Create a fake http token
	    if {![info exists http::http(uid)]} {
		set http::http(uid) 0
	    }
	    set token ::http::[incr http::http(uid)]
###	    puts "token is $token"
	    array set $token {
		state		eof
		meta		{}
		currentsize	0
		totalsize	0
		type            {}
		body            {}
		status		"error"
		error           "GeturlWhole $error"
		http            "GeturlWhole 404 $error"
	    }
	    return $token
	}


###	puts [array get ::$httpvar]
	set cursize [set $httpvar\(totalsize)]
###	puts "Loop $nloop size: $cursize"
	http::cleanup $httpvar
	unset httpvar

	;##- If the size is an exact multiple of 4096 bytes (the default Tcl
	;##- background-copy buffer size), then it is likely that LDAS is
	;##- still in the middle of writing the file.  In this case we want
	;##- to wait until the size is stable for 10 loop iterations.
	if { [expr {$cursize % 4096}] == 0 } {
	    if { $cursize == $lastsize } {
		incr repx4096
	    } else {
		set repx4096 1
	    }
	} else {
	    ;##- No special treatment
	    set repx4096 999
	}

	;##- Sleep for a while before checking the size again.
	set ::geturlWholeFlag($url) 0
	after 1000 "set ::geturlWholeFlag($url) 1"
	vwait ::geturlWholeFlag($url)
	unset ::geturlWholeFlag($url)
    }

    ;##- Now actually retrieve the file
    set httpvar [eval http::geturl $url $args]

    ;##- Check the size again
    set actualsize [set $httpvar\(totalsize)]
###    puts "Actual size: $actualsize"
    if { $actualsize > $cursize } {
	BigMessageBox -icon warning -title "File changed size" -message \
		"WARNING: The size of $url changed while it was being\
		downloaded!"
    }

###    ;##- Finally, make sure the size didn't change again
###    set httpvar2 [eval http::geturl $url -validate 1]
###    set checksize [set $httpvar2\(totalsize)]
###    http::cleanup $httpvar2
###    unset httpvar2
###    puts "Check size: $checksize"

    return $httpvar
}


##=========================================================================
proc pwdec { name1 name2 op } {
    upvar 1 $name1 pw

    if { [regexp {^[0-9A-F]{32,}$} $pw] } {

        set len [string length $pw]
        if {$len < 16} { set len 16 }
        set encstr [string range [string repeat $::tcl_platform(user) 16] 0 [expr {$len-1}]]
        binary scan $encstr c* list2

        set dec ""
        foreach {char1 char2} [split $pw {}] val2 $list2 {
            scan $char1$char2 %x val3
            set val [expr {($val3+256*(17-($val3%17)))/17-$val2}]
            if {$val == 0} { break }
            append dec [binary format c $val]
        }
        set pw $dec
    }
    return
}

##=========================================================================
proc register { user } {
    uplevel #0 trace variable dbpass r pwdec
}


##=========================================================================
## Name: Tk text widget workarounds
##
## Description:
##   Workarounds to fix bizzare behavior when extending a selection
##   initiated by double-clicking in a text widget.

##=========================================================================
bind Text <Double-1> {
    global tcl_version
    if { $tcl_version <= 8.3 } {
	set tkPriv(selectMode) word
	tkTextSelectTo %W %x %y
#---- Following 2 lines commented out by PSS
###        catch {%W mark set insert sel.last}
###        catch {%W mark set anchor sel.first}
    } else {
	#-- Standard code for Tcl 8.4
	set tk::Priv(selectMode) word
	tk::TextSelectTo %W %x %y
	catch {%W mark set insert sel.last}
    }
}

##=========================================================================
bind Text <Triple-1> {
    global tcl_version
    if { $tcl_version <= 8.3 } {
        set tkPriv(selectMode) line
        tkTextSelectTo %W %x %y
#---- Following 2 lines commented out by PSS
###        catch {%W mark set insert sel.last}
###        catch {%W mark set anchor sel.first}
    } else {
	#-- Standard code for Tcl 8.4
	set tk::Priv(selectMode) line
	tk::TextSelectTo %W %x %y
	catch {%W mark set insert sel.last}
    }
}


##=========================================================================
proc tkTextButton1 {w x y} {
    global tkPriv

    set tkPriv(selectMode) char
    set tkPriv(mouseMoved) 0
    set tkPriv(pressX) $x
    $w mark set insert [tkTextClosestGap $w $x $y]
    $w mark set anchor insert
#---- Beginning of new code added by PSS
    ;##- Set the anchor mark's gravity depending on the click position
    ;##- relative to the gap
    set bbox [$w bbox [$w index anchor]]
    if {$x > [lindex $bbox 0]} {
	set side right
    } else {
	set side left
    }
    $w mark gravity anchor $side
#---- End of new code
    if {[string equal [$w cget -state] "normal"]} {focus $w}
}


##=========================================================================
proc tkTextSelectTo {w x y {extend 0}} {
    global tkPriv tcl_platform

    set cur [tkTextClosestGap $w $x $y]
    if {[catch {$w index anchor}]} {
	$w mark set anchor $cur
    }
    set anchor [$w index anchor]
    if {[$w compare $cur != $anchor] || (abs($tkPriv(pressX) - $x) >= 3)} {
	set tkPriv(mouseMoved) 1
    }
    switch $tkPriv(selectMode) {
	char {
	    if {[$w compare $cur < anchor]} {
		set first $cur
		set last anchor
	    } else {
		set first anchor
		set last $cur
	    }
	}
	word {
#---- Beginning of section rewritten by PSS
	    ;##- Set initial range based only on the anchor (1 char min width)
	    if {[string equal [$w mark gravity anchor] "right"]} {
		set lindex "anchor"
		set rindex "anchor + 1c"
	    } else {
		set lindex "anchor - 1c"
		set rindex "anchor"
	    }
	    ;##- Extend range (if necessary) based on the current point
	    if {[$w compare $cur < $lindex]} {
		set lindex $cur
	    } elseif {[$w compare $cur > $rindex]} {
		set rindex $cur
	    }
	    ;##- Now find word boundaries
	    set first [tkTextPrevPos $w "$lindex + 1c" tcl_wordBreakBefore]
	    set last [tkTextNextPos $w "$rindex - 1c" tcl_wordBreakAfter]
#---- End of rewritten section
	}
	line {
#---- Beginning of section rewritten by PSS
	    ;##- Set initial range based only on the anchor
	    set lindex "anchor linestart"
	    set rindex "anchor - 1c lineend"
	    ;##- Extend range (if necessary) based on the current point
	    if {[$w compare $cur < $lindex]} {
		set lindex "$cur linestart"
	    } elseif {[$w compare $cur > $rindex]} {
		set rindex "$cur -1c lineend"
	    }
	    set first [$w index $lindex]
	    set last [$w index "$rindex + 1c"]
#---- End of rewritten section
	}
    }
    if {$tkPriv(mouseMoved) || [string compare $tkPriv(selectMode) "char"]} {
	if {[string compare $tcl_platform(platform) "unix"] \
		&& [$w compare $cur < anchor]} {
	    $w mark set insert $first
	} else {
	    $w mark set insert $last
	}
	$w tag remove sel 0.0 $first
	$w tag add sel $first $last
	$w tag remove sel $last end
	update idletasks
    }
}


##=========================================================================
## Name: bgerror
##
## Description:
##   Customized version of the standard Tk bgerror routine.
##
## Usage:
##   bgerror err
##
## Comments:
##   Requests email.

proc bgerror { err } {
    global errorInfo
    
    ;##- Be sure to release any grabs that might be present on the screen
    if {[string compare [grab current .] ""]} {
        grab release [grab current .]
    }

    ;##- Assemble the message
    if { [string is space $errorInfo] } {
	set msg "An unexpected Tcl/Tk error has occurred.\nPlease send email\
		to shawhan_p@ligo.caltech.edu describing the circumstances,\
		and include the error message below.  Thank you!\n\n$err"
    } else {
	set msg "An unexpected Tcl/Tk error has occurred.\nPlease send email\
		to shawhan_p@ligo.caltech.edu describing the circumstances,\
		and include the stack trace below.  Thank you!\n\n$errorInfo"
    }

    ;##- Put up the dialog box
    BigMessageBox -icon warning -title "Tcl/Tk Error" -message $msg -grab 1
    return
}


##=========================================================================
## Name: selsub
##
## Description:
##   Utility routine to do selective substitution of variables in a string
##   and return the string thus modified.
##
## Parameters:
##   text -- original string
##   args -- variable(s) to be substituted
##
## Usage:
##   selsub text var1 var2 ...
##
## Comments:
##   I wrote this routine to avoid having big chunks of highly backslashed
##   code between double quotes.  These generally arose when I was defining
##   a command associated with a button or a key binding, and I needed one
##   or a few variables to be evaluated when the command was defined, and
##   others to be evaluated when it was run.  (Yes, I know, I could define
##   a separate proc and pass the promptly-evaluated values as arguments,
##   but I generally like to keep the code with the button definition so
##   it's clear what the button does.)  Anyway, this routine lets me put
##   the command in braces (so I don't have to escape stuff inside) and
##   then explicitly specify which variables I want evaluated.  It only
##   does scalars, and does not do any command substitution.
##
## selsub is essentially the same as "subst -nobackslashes -nocommands",
## except that you can specify which variables you want to substitute.
## With "subst", it is all-or-none.
##
## The regular expression below is highly backslashed because we need $sub
## to be evaluated; it becomes:
##   ((\A|[^\\]))\$<subval>(?!\w)
## as seen by regsub.
##
## WARNING: The character sequences & and \n (where n is a number) are
## treated specially by regsub.  Therefore, do not use selsub when the
## variable value being substituted in contains one of these.

proc selsub { text args } {
    foreach sub $args {
	upvar 1 $sub var
	if {[info exists var]} {
	    regsub -all -- "\(\(\\A|\[^\\\\\]\)\)\\$$sub\(?!\\w\)" \
		    $text \\1$var text
	}
    }
    return $text
}

##=========================================================================
## Name: subbut
##
## Description:
##   Utility routine to do selective substitution of variables in a string
##   and return the string thus modified.
##
## Parameters:
##   text -- original string
##   args -- variable(s) NOT to be substituted
##
## Usage:
##   subbut text var1 var2 ...
##
## Comments:
##   This is the essentially the complement to "selsub", but its internal
##   operation is completely different.  It is also more robust, since
##   you do not have to worry about special character sequences (e.g. an
##   ampersand) which can mess up selsub.

proc subbut { text args } {

    ;##- Protect the text against substitutions by the interpreter
    set work [list $text]

    ;##- "Turn off" each of specified variable by replacing the dollar sign
    foreach varname $args {
	regsub -all -- "\\\$(?=${varname}(?:\\W|\\Z))" \
		$work " _%_SUBBUT_%_" work
    }

    ;##- Substitute values for all the remaining variables
    set work [uplevel subst -nobackslashes -nocommands $work]

    ;##- Restore dollar signs
    regsub -all -- " _%_SUBBUT_%_" $work \$ work

    return $work
}

##=========================================================================
##=========================================================================
## "scrolledtable":
## Pseudo-megawidget to display a table, scrollable by rows and columns.
## Created to work with guild (graphical user interface to LIGO databases)
## by Peter Shawhan, December 1999.
## Documentation last updated Jan 21, 2000 by Peter Shawhan.
## .
## A scrolledtable behaves almost like a true Tk widget.  The "almost" part
## is that the proc created with the same name as the widget refers only to
## the frame which contains everything else, so to operate on the widget,
## one must preface any operation with "scrolledtable".  (There is probably
## a trick to get around this, but it's not a big deal.)
## .
## The available operations are:
##  *  scrolledtable <name> ?<options>? : 
##             The available options are the same as for a text widget.
##  *  scrolledtable <name> column add <column_name> <val_list> : 
##             Adds a column to the table.  "val_list" is a list of values.
##  *  scrolledtable <name> column width <column> <width> : 
##             Modifies the width of a column.  The column can be specified
##             either by name or by number (starting from 0).
##  *  scrolledtable <name> rowbutton <widget> : 
##             Registers a button or menubutton as something which operates
##             on the selected row; thus, this button is automatically
##             enabled/disabled depending on whether any row is selected.
##  *  scrolledtable <name> B2Action <clicks> <colname> <proc> : 
##             Registers a procedure to convert a value when clicked on
##             with the middle mouse button.
##  *  scrolledtable <name> getcolnames : 
##             Returns a list containing all the column names.
##  *  scrolledtable <name> getrow <row> ?<column_name>? : 
##             If a column_name is specified, returns the value in that
##             column for the specified row (numbered starting from 1, or "sel"
##             for the currently selected row, or "end" for the last row);
##             otherwise, returns all values for the specified row as a list.
##  *  scrolledtable <name> getcolwidth ?<column_name>? : 
##             If a column_name is specified, returns the current display
##             width for the column (-1 if it is hidden); if no column_name
##             is specified, returns a list giving the widths for all columns.
##  *  scrolledtable <name> item_at <x> <y> : 
##             Returns a two-element list with the column name and value
##             at the specified pixel position, or null strings if the
##             position is not within an item in the table.
## .

##=========================================================================
## Name: Package provided
##
## Comments:
##   This package could be used by other Tcl/Tk programs, if desired.

;#barecode
package provide scrolledtable 1.0
;#end  

##=========================================================================
## Name: Namespace eval scrolledtable
##
## Description:
##   Namespace for use by scrolledtable pseudo-megawidgets
## 
## Comments:
##   Includes some general parameters which apply to all instances.
##   Instances create other variables in this namespace as needed.

;#barecode
namespace eval scrolledtable {

    ;##- General parameters which apply to all instances
    variable rownumWidth 7
    variable defColumnWidth 22    ;##- Default maximum width for a column
    variable selectedColColor yellow
    variable selectedRowColor lemonchiffon
    variable selectedDataColor lemonchiffon

    ;##- Make all procedures visible to "namespace import"
    namespace export *
}
;#end

##=========================================================================
## Name: scrolledtable::scrolledtable
##
## Description:
##   Main routine to create a scrolledtable pseudo-megawidget and perform
##   various operations on it.
##
## Parameters:
##   name -- Tk pathname of scrolledtable widget
##   ?<options>? -- same options as for a text widget
##   column_name -- name of a column
##   val_list -- list containing values in a column
##   column -- column name OR number (counting from 0)
##   widget -- Tk pathname of a widget which is to be enabled/disabled
##                whenever a row is selected/deselected
##
## Usage:
##   scrolledtable <name> ?<options>?
##   scrolledtable <name> column add <column_name> <val_list>
##   scrolledtable <name> column width <column> <width>
##   scrolledtable <name> rowbutton <widget>
##   scrolledtable <name> getcolnames
##   scrolledtable <name> getrow <row> ?<column_name>?
##   scrolledtable <name> getcolwidth ?<column_name>?
##   scrolledtable <name> item_at <x> <y>
##
## Comments:
##   This is the only routine in the scrolledtable package which needs to
##   be visible to the outside user.
## .
##   The table contents are displayed in a text widget, with tabs separating
##   the values in a given row to keep things lined up without relying on
##   extra spaces.  A plus sign is added after each value; then, a text tag
##   with the "-elide" property (introduced in Tcl/Tk 8.3b1) is used to
##   hide EITHER the plus sign OR the part of the value which exceeds the
##   width of the column.  Therefore, changing the width of a column only
##   causes a change in the way the text is tagged, not a change in the
##   actual contents of the text widget.

proc scrolledtable::scrolledtable { f args } {
###    puts "scrolledtable called with f=$f"
    ;##- The scrolledtable widget takes all the same options as the text
    ;##- widget.  The height and width refer to the main table area.

    ;##- Check that the user is running a recent enough version of Tcl/Tk
    set tclversion [info tclversion]
    set patchlevel [info patchlevel]
    ;##- Trim off the version from the patchlevel string
    set patchlevel [ string replace $patchlevel 0 \
	    [expr {[string length $tclversion]-1}] ]
    if { $tclversion<8.3 || \
	    ($tclversion==8.3 && [string match a* $patchlevel]) } {
	return -code error -errorinfo "The scrolledtable widget requires\
		Tcl/Tk version 8.3b1 or later"
	return ""
    }

    ;##- See if the widget already exists, i.e. there is a state array in
    ;##- the namespace with a matching name
    variable state$f
    if {[array exists state$f] == 0} {

	;##- Create a state array and pre-load it with some parameters,
	;##- i.e. make an instance of the widget
	array set state$f { nColumns 0 columnNames {} columnShown {} \
		colMaxValWidths {} colMaxUseWidths {} \
		colUseWidths {} colEffWidths {} \
		columnFirsts {} columnLasts {} \
		nRows -1 selectedRow -1 rowWidths {} rowButtons {} \
		selectedCol -1 \
	    }

	;##- Set the operation to "init"
	set oper "init"
	if {[lindex $args 0] == "init"} {
	    set args [lrange $args 1 end]
	}


###- This does not work, because we create a frame with the same name as the
###- scrolledtable (as required by the Tk widget naming hierarchy), which
###- defines its own proc with that name.  There is probably a way to get
###- around this by renaming procs, but I won't do that for now.
###	;##- Define a proc (in the global namespace) with the same name as
###	;##- the widget, so that one can do widget operations with the 
###	;##- customary syntax
###	eval {proc ::$f {args} "eval scrolledtable::scrolledtable $f \$args"}

    } else {

	;##- Strip off the first element of the args list, as the operation
	set oper [lindex $args 0]
	set args [lreplace $args 0 0]

    }

###    puts "Operation is $oper, remaining arguments are $args"

    ;##- Make an alias to the state array for this instance, for convenience
    upvar 0 state$f state

    ;##- Now switch based on the operation
    switch -- $oper {

	init {
	    return [scrolledtable::Init $f $args]
	}

	column {
	    ;##- Get the column operation from the args list
	    set oper [lindex $args 0]
###	    puts "Column operation is $oper"
	    set arglist [lrange $args 1 end]
	    scrolledtable::Column $f $oper $arglist
	}

	rowbutton {
	    ;##- Get the button name
	    set widget [lindex $args 0]
	    ;##- Append it to the list
	    lappend state(rowButtons) $widget
	    ;##- Enable/disable the button based on whether a row is selected
	    if { $state(selectedRow) > -1 } {
		$widget configure -state normal
	    } else {
		$widget configure -state disabled
	    }
	}

	B2Action {
	    ;##- Get  arguments
	    set clicks [lindex $args 0]
	    set colname [string tolower [lindex $args 1]]
	    set proc [lindex $args 2]

	    set state(B2Action$clicks.$colname) $proc
	}

	getcolnames {
	    return $state(columnNames)
	}

	getrow {
	    set irow [lindex $args 0]
	    if { [string match sel* $irow] } {
		;##- Look up the number of the selected row
		set irow $state(selectedRow)
	    } elseif { [string equal "end" $irow] } {
		set irow $state(nRows)
	    }
	    if { $irow <= 0 } { return "" }

	    ;##- See if a specific column was specified.
	    if {[llength $args] > 1} {

		;##- Translate column name to column number.  Need a
		;##- case-insensitive comparison.
		set colname [string tolower [lindex $args 1]]
		set icol -1
		set jcol -1
		foreach name $state(columnNames) {
		    incr jcol
		    if {[string equal $colname [string tolower $name]]} {
			set icol $jcol
			break
		    }
		}
		if { $icol == -1 } { return "" }

		;##- Get the value out of the text widget
		variable valpos${f}_col$icol
		variable valwidth${f}_col$icol
		upvar 0 valpos${f}_col$icol valposlist
		upvar 0 valwidth${f}_col$icol valwidthlist
		set valpos [lindex $valposlist [expr {$irow-1}]]
		set valwidth [lindex $valwidthlist [expr {$irow-1}]]
		set val [$f.text get \
			$irow.$valpos $irow.[expr {$valpos+$valwidth}]]
		return $val

	    } else {
		;##- Return a list of all values for this row
		set vallist {}
		for {set icol 0} {$icol < $state(nColumns)} {incr icol} {
		    variable valpos${f}_col$icol
		    variable valwidth${f}_col$icol
		    upvar 0 valpos${f}_col$icol valposlist
		    upvar 0 valwidth${f}_col$icol valwidthlist
		    set valpos [lindex $valposlist [expr {$irow-1}]]
		    set valwidth [lindex $valwidthlist [expr {$irow-1}]]
		    set val [$f.text get \
			    $irow.$valpos $irow.[expr {$valpos+$valwidth}]]
		    lappend vallist $val
		}
		return $vallist

	    }
	}

	getcolwidth {
	    ;##- See if a specific column was specified.
	    if {[llength $args] > 0} {

		;##- Translate column name to column number.  Need a
		;##- case-insensitive comparison.
		set colname [string tolower [lindex $args 0]]
		set icol -1
		set jcol -1
		foreach name $state(columnNames) {
		    incr jcol
		    if {[string equal $colname [string tolower $name]]} {
			set icol $jcol
			break
		    }
		}
		if { $icol == -1 } { return "" }

		return [lindex $state(colEffWidths) $icol]

	    } else {
		return $state(colEffWidths)
	    }
	}

	item_at {

	    ;##- Get the position arguments
	    set x [lindex $args 0]
	    set y [lindex $args 1]

	    ;##- Figure out what row this is
	    set textindex [$f.text index @$x,$y]
	    set dotpos [string first . $textindex]
	    set irow [string range $textindex 0 [expr $dotpos-1] ]

	    ;##- Get the absolute column position by indexing the colheads area
	    set headindex [$f.colheads index @$x,5]
	    set dotpos [string first . $headindex]
	    set charpos [string range $headindex [expr $dotpos+1] end]

	    ;##- Figure out which column this is
	    set selcol -1
	    set icol -1
	    foreach first $state(columnFirsts) last $state(columnLasts) {
		incr icol
		if { $charpos >= $first && $charpos <= $last } {
		    set selcol $icol
		    break
		}
	    }
	    if { $selcol == -1 } { return [list {} {} {}] }

	    ;##- Get the column name
	    set colname [lindex $state(columnNames) $icol]

	    ;##- Get the value out of the text widget
	    variable valpos${f}_col$icol
	    variable valwidth${f}_col$icol
	    upvar 0 valpos${f}_col$icol valposlist
	    upvar 0 valwidth${f}_col$icol valwidthlist
	    set valpos [lindex $valposlist [expr {$irow-1}]]
	    set valwidth [lindex $valwidthlist [expr {$irow-1}]]
	    set value [$f.text get \
		    $irow.$valpos $irow.[expr {$valpos+$valwidth}]]

	    return [list $irow.$valpos $colname $value]

	}

	default {
	    return -code error -errorinfo "Bad operation \"$oper\":\
		    must be column, rowbutton, B2Action,\
		    getcolnames, getrow, getcolwidth, item_at"
	    return
	}
    }

    return
}

##=========================================================================
## Name: scrolledtable::Init
##
## Description:
##   Routine to initialize a scrolledtable pseudo-widget.
## 
## Parameters:
##   f -- Name of scrolledtable widget
##   arglist -- List of arguments to use when creating text widgets
##
## Usage:
##   scrolledtable::Init f arglist
##
## Comments:
##   Called by scrolledtable::scrolledtable.

proc scrolledtable::Init { f arglist } {
    ;##- Should probably check arglist, else say:
    ;##- unknown option "<opt>"

    global tcl_version

    ;##- Access the state array in the namespace
    variable state$f
    ;##- Make an alias to the state array for this instance, for convenience
    upvar 0 state$f state

    ;##- Create a frame with the specified widget name
    frame $f

    ;##- Create sub-widgets
    frame $f.colinfo
    entry $f.colinfo.message -relief flat -highlightcolor $::bgColor
    bind $f.colinfo.message <Button> "focus %W"
    $f.colinfo.message insert end "Columns"
    $f.colinfo.message configure -state $::entrydis
    button $f.colinfo.hide -text "Hide" -pady 0 -state disabled \
	    -command "scrolledtable::HideCol $f" -underline 0
    button $f.colinfo.show -text "Show" -pady 0 -state disabled \
	    -command "scrolledtable::ShowCol $f" -underline 0
    button $f.colinfo.resize -text "Resize" -pady 0 -state disabled \
	    -command "scrolledtable::ResizeCol $f" -underline 0

    ;##- Set up key bindings to the hide/show/resize buttons
    bind [winfo toplevel $f] <Alt-h> "$f.colinfo.hide invoke"
    bind [winfo toplevel $f] <Alt-s> "$f.colinfo.show invoke"
    bind [winfo toplevel $f] <Alt-r> "$f.colinfo.resize invoke"

    label $f.rownumlabel -text "Rows" \
	    -justify center -width $scrolledtable::rownumWidth
    eval {text $f.colheads -wrap none -cursor left_ptr \
	    -xscrollcommand [list $f.xscroll set]} \
	    $arglist -height 1
    eval {text $f.rownums -wrap none -padx 4 -cursor left_ptr \
	    -yscrollcommand [list $f.yscroll set]} \
	    $arglist -width $scrolledtable::rownumWidth
    eval {text $f.text -wrap none \
	    -xscrollcommand [list $f.xscroll set] \
	    -yscrollcommand [list $f.yscroll set]} \
	    -setgrid true $arglist
    bind $f.text <Button> "focus %W"
	    
    ;##- Set up scrollbars which act on multiple widgets
    scrollbar $f.xscroll -orient horizontal \
	    -command [list scrolledtable::ScrollBothCols $f]
    scrollbar $f.yscroll -orient vertical \
	    -command [list scrolledtable::ScrollBothRows $f]

    ;##- Prevent text selection in the colheads and rownums widgets.
    bind $f.colheads <B1-Motion> {break}
    bind $f.rownums <B1-Motion> {break}
    bind $f.colheads <Double-Button-1> {break}
    bind $f.rownums <Double-Button-1> {break}
    bind $f.colheads <Triple-Button-1> {break}
    bind $f.rownums <Triple-Button-1> {break}

    ;##- Prevent scrolling when leaving a text widget with button
    ;##- pressed, since other widgets don't scroll in sync.
    bind $f.colheads <Leave> {break}
    bind $f.rownums <Leave> {break}
    bind $f.text <Leave> {break}

    ;##- Prevent scrolling with the middle mouse button
    bind $f.colheads <B2-Motion> {break}
    bind $f.rownums <B2-Motion> {break}
    bind $f.text <B2-Motion> {break}

    ;##- Mouse button bindings to select a column
    bind $f.colheads <Button-1> {
	if { $tcl_version <= 8.3 } {
	    tkTextButton1 %W %x %y
	} else {
	    tk::TextButton1 %W %x %y
	}
	;##- Figure out the current cursor position
	set curindex [%W index current]
	set dotpos [string first . $curindex]
	set charpos [string range $curindex [expr $dotpos+1] end]
	set widget [winfo parent %W]
	scrolledtable::ClickCol $widget $charpos
    }

    bind $f.colheads <Double-Button-1> {
	if { $tcl_version <= 8.3 } {
	    tkTextButton1 %W %x %y
	} else {
	    tk::TextButton1 %W %x %y
	}
	;##- Figure out the current cursor position
	set curindex [%W index current]
	set dotpos [string first . $curindex]
	set charpos [string range $curindex [expr $dotpos+1] end]
	set widget [winfo parent %W]
	scrolledtable::ClickCol $widget $charpos 2
	scrolledtable::ToggleCol $widget
	break
    }

    ;##- Mouse button bindings to select a row
    bind $f.rownums <Button-1> {
	if { $tcl_version <= 8.3 } {
	    tkTextButton1 %W %x %y
	} else {
	    tk::TextButton1 %W %x %y
	}
	set irow [expr int([%W index current])]
	set widget [winfo parent %W]
	scrolledtable::ClickRow $widget $irow
    }

    bind $f.rownums <Double-Button-1> {
	if { $tcl_version <= 8.3 } {
	    tkTextButton1 %W %x %y
	} else {
	    tk::TextButton1 %W %x %y
	}
	set irow [expr int([%W index current])]
	set widget [winfo parent %W]
	;##- Select row, unless it is already selected
	if {[set scrolledtable::state$widget\(selectedRow)] != $irow} {
	    scrolledtable::ClickRow $widget $irow
	}
    }

    ;##- Mouse bindings for pop-ups
    bind $f.text <Button-2> { scrolledtable::ValuePopup %W %x %y 1 }
    bind $f.text <Double-Button-2> { scrolledtable::ValuePopup %W %x %y 2 }
    bind $f.text <ButtonRelease-2> \
	    "if \[winfo exists $f.text.msg\] {destroy $f.text.msg}"

    ;##- Configure the tags for selections in each widget
    $f.colheads tag configure selected \
	    -background $scrolledtable::selectedColColor
    $f.rownums tag configure selected \
	    -background $scrolledtable::selectedRowColor
    $f.text tag configure selected \
	    -background $scrolledtable::selectedDataColor

    ;##- Configure a "red text" tag for the main text area
    $f.text tag configure redtext -foreground red

    ;##- Configure the tags to hide text
    if {[info patchlevel] == "8.3b1"} {
	$f.colheads tag configure hidden -state hidden
	$f.text tag configure hidden -state hidden
    } else {
	$f.colheads tag configure hidden -elide 1
	$f.text tag configure hidden -elide 1
    }

    ;##- Configure the tag to right-justify the row numbers
    $f.rownums tag configure rightjustify -justify right

    ;##- Disable modification of the text boxes
    $f.colheads configure -state disabled
    $f.rownums configure -state disabled
    $f.text configure -state disabled

    ;##- Lay out the column-info widgets
    grid $f.colinfo.message $f.colinfo.hide \
	    $f.colinfo.show $f.colinfo.resize -sticky news
    grid columnconfigure $f.colinfo 0 -weight 1

    ;##- Lay out the widgets
    grid $f.colinfo -column 1 -sticky news
    grid $f.rownumlabel $f.colheads -sticky news
    grid $f.rownums $f.text $f.yscroll -sticky news
    grid $f.xscroll -column 1 -sticky news
    grid rowconfigure $f 2 -weight 1     ;##- This row is resizeable
    grid columnconfigure $f 1 -weight 1  ;##- This column is resizeable

    ;##- If necessary, create the little bitmaps which are used
    ;##- to separate the column headings
    if {! [info exists scrolledtable::charwidth]} {
	MakeBitmaps [$f.text cget -font]
    }

    return $f
}


##=========================================================================
## Name: scrolledtable::Column
##
## Description:
##   Column operations for scrolledtable pseudo-widget.
## 
## Parameters:
##   f -- Name of scrolledtable widget
##   oper -- Operation to perform
##   arglist -- List of arguments
##
## Usage:
##   scrolledtable::Column f oper arglist
##
## Comments:
##   Called by scrolledtable::scrolledtable.

proc scrolledtable::Column { f oper arglist } {

    ;##- Access the state array in the namespace
    variable state$f
    ;##- Make an alias to the state array for this instance, for convenience
    upvar 0 state$f state

    switch -- $oper {

	add {
	    set colname [lindex $arglist 0]
	    set vallistname [lindex $arglist 1]
	    ;##- Reference list which was passed by name
	    upvar 2 $vallistname vallist

	    ;##- Check for any additional arguments
	    array set mods [lrange $arglist 2 end]

	    ;##- Store information about the column in the state array
	    incr state(nColumns)
	    set icol [expr {$state(nColumns)-1}]
	    lappend state(columnNames) $colname
	    lappend state(columnShown) 1

	    ;##- Enable modification of the colheads and text widgets
	    $f.colheads configure -state normal
	    $f.text configure -state normal

	    ;##- If this is the first column added, count the number
	    ;##- of rows and put row numbers into the rownums widget.
	    ;##- Also put a tab and a newline into the main text widget
	    ;##- for each row, and a space into the colheads widget.
	    ;##- Finally, initialize the rowWidths list.
	    if { $state(nColumns) == 1 } {
		set state(nRows) [llength $vallist]

		;##- Enable modification of the rownum widget contents
		$f.rownums configure -state normal

		;##- Insert a single space into the colheads widget
		$f.colheads insert end " "

		;##- Account for any row-number offset
		if { [info exists mods(-rowoffset)] } {
		    set rowoffset $mods(-rowoffset)
		} else {
		    set rowoffset 0
		}
		set firstrow [expr {1+$rowoffset}]
		set lastrow [expr {$state(nRows)+$rowoffset}]

		;##- Insert row numbers into the rownums widget,
		;##- and tabs and newlines into the text widget
		for {set i $firstrow} {$i <= $lastrow} {incr i} {
		    $f.rownums insert end "$i\n"
		    $f.text insert end "\t\n"
		}

		;##- Delete the final newlines
		$f.rownums delete "end -1 char" end
		$f.text delete "end -1 char" end

		;##- Disable modification of the rownum widget
		$f.rownums configure -state disabled

		;##- Right-justify the row numbers
		$f.rownums tag add rightjustify 1.0 end

		;##- Initialize the rowWidths list
		for {set i 1} {$i <= $state(nRows)} {incr i} {
		    lappend state(rowWidths) 1
		}

	    }

	    ;##- Add the column name to the colheads widget
	    $f.colheads image create "1.end -1 chars" \
		    -image $scrolledtable::rightbar
	    $f.colheads insert "1.end -1 chars" $colname

	    ;##- Add each value to the text widget.  Also record the
	    ;##- width of each value, as well as the character
	    ;##- position at which it begins in its row.
	    ;##- Also keep track of the maximum width.
	    variable valpos${f}_col$icol
	    variable valwidth${f}_col$icol
	    upvar 0 valpos${f}_col$icol valposlist
	    upvar 0 valwidth${f}_col$icol valwidthlist
	    set oldRowWidths $state(rowWidths)
	    set state(rowWidths) {}
	    set maxvalwidth 0
	    set irow 0
	    foreach val $vallist oldrowwidth $oldRowWidths {
		incr irow
		$f.text insert $irow.end $val
		set itemwidth [string length $val]
		if {$itemwidth > $maxvalwidth} {
		    set maxvalwidth $itemwidth
		}
		lappend valwidthlist $itemwidth
		lappend valposlist $oldrowwidth
		lappend state(rowWidths) [expr {$oldrowwidth+$itemwidth+2}]
	    }

	    ;##- See whether the column name is wider than all values
	    set colnamewidth [string length $colname]
	    if { $maxvalwidth > $colnamewidth } {
		set maxusewidth $maxvalwidth
	    } else {
		set maxusewidth $colnamewidth
	    }

	    ;##- Figure out the initial width to use (when shown)
	    if { $maxusewidth <= $scrolledtable::defColumnWidth } {
		set colusewidth $maxusewidth
	    } else {
		set colusewidth $scrolledtable::defColumnWidth
	    }

	    ;##- Pad column name to the maximum possible width
	    set padwidth [expr {$maxusewidth-$colnamewidth}]
	    $f.colheads insert "1.end -1 chars" [string repeat " " $padwidth]
	    set overrun [expr {$colnamewidth-$colusewidth}]
	    if { $overrun <= 0 } {
		$f.colheads image create "1.end -1 chars" \
			-image $scrolledtable::leftbar
	    } else {
		$f.colheads image create "1.end -1 chars" \
			-image $scrolledtable::leftbarplus
	    }

	    ;##- Hide part of the column name, if necessary
	    set overrun [expr {$maxusewidth-$colusewidth}]
	    if { $overrun > 0 } {
		$f.colheads tag add hidden \
			"1.end -$overrun chars -2 chars" \
			"1.end -2 chars"
	    }

	    ;##- Record the extent of the column header (in characters)
	    if { $state(nColumns) == 1 } {
		set state(columnFirsts) [list 0]
		set state(columnLasts) [list [expr {$maxusewidth+1}]]
	    } else {
		lappend state(columnFirsts) \
			[expr {[lindex $state(columnLasts) end] + 1}]
		lappend state(columnLasts) \
			[expr {[lindex $state(columnLasts) end] + \
			$maxusewidth+2}]
	    }

	    ;##- Store information about the column in the state array
	    lappend state(colMaxValWidths) $maxvalwidth
	    lappend state(colMaxUseWidths) $maxusewidth
	    lappend state(colUseWidths) $colusewidth
	    lappend state(colEffWidths) $colusewidth

	    ;##- Update the tab stops in the main text area
	    set curpos 1
	    set tabstops [list $scrolledtable::charwidth]
	    foreach coleffwidth $state(colEffWidths) {
		incr curpos [expr {$coleffwidth+2}]
		lappend tabstops [expr {$curpos*$scrolledtable::charwidth}]
	    }
###	    puts "For column $colname, setting tab stops to $tabstops"
	    $f.text configure -tabs $tabstops

	    ;##- Insert truncation marks and tabs at the end of each
	    ;##- line in the main text area, and hide whatever should
	    ;##- be hidden
	    upvar 0 valpos${f}_col$icol valposlist
	    upvar 0 valwidth${f}_col$icol valwidthlist
	    set irow 0
	    foreach valpos $valposlist valwidth $valwidthlist \
		    rowwidth $state(rowWidths) {

		incr irow
		$f.text insert $irow.end "+\t"

		if { $valwidth <= $colusewidth } {
		    ;##- Just hide the plus sign
		    $f.text tag add hidden \
			    "$irow.$rowwidth -2c" "$irow.$rowwidth -1c"
		} else {
		    ;##- Hide part of the value;
		    ;##- plus sign will still be visible
		    $f.text tag add hidden \
			    "$irow.$valpos +$colusewidth chars" \
			    "$irow.$rowwidth -2c"
		    ;##- Turn the plus sign red
		    $f.text tag add redtext \
			    "$irow.$rowwidth -2c" "$irow.$rowwidth -1c"
		}
	    }

	    ;##- Disable modification of the colheads and text widgets
	    $f.colheads configure -state disabled
	    $f.text configure -state disabled

	}

	width {
	    set icol [lindex $arglist 0]   ;##- Either name or number
	    set width [lindex $arglist 1]

	    set state(colUseWidths) \
		    [lreplace $state(colUseWidths) $icol $icol $width]
	    if { [lindex $state(columnShown) $icol] == 1 } {
		scrolledtable::UpdateCol $f $icol $width
	    }
	}

	default {
	    return -code error -errorinfo "Bad column operation \"$oper\":\
		    must be add, width"
	}

    }
    ;##- End of switches on specific column operation

    return
}


##=========================================================================
## Name: scrolledtable::ScrollBothCols
##
## Description:
##   Routine which causes the main text area and column-headings area to
##   be scrolled in sync by a single scrollbar.
## 
## Parameters:
##   f -- Tk pathname of scrolledtable widget
##   args -- The usual arguments which are tacked onto an "xview" command
##
## Usage:
##   scrolledtable::ScrollBothCols f args 
##
## Comments:
##   This relies on the contents of the two text widgets having exactly
##   the same width!  This is the case for the way we lay out the column
##   names and values.

proc scrolledtable::ScrollBothCols { f args } {
    eval "$f.text xview $args; $f.colheads xview $args"
    return
}

##=========================================================================
## Name: scrolledtable::ScrollBothRows
##
## Description:
##   Routine which causes the main text area and row-number area to
##   be scrolled in sync by a single scrollbar.
## 
## Parameters:
##   f -- Tk pathname of scrolledtable widget
##   args -- The usual arguments which are tacked onto a "yview" command
##
## Usage:
##   scrolledtable::ScrollBothRows f args 
##
## Comments:
##   The text area is scrolled first; the row-number area is then synced
##   up based on the line number at the top of the window.  This
##   guarantees synchronization better than doing
##      eval "$f.rownums yview $args
##   which apparently suffered from round-off error at times.

proc scrolledtable::ScrollBothRows { f args } {
    eval "$f.text yview $args"
    $f.rownums yview [$f.text index @0,0]
    return
}

##=========================================================================
## Name: scrolledtable::ValuePopup
##
## Description:
##   Pop up a little text box over the value which is clicked on.  The
##   contents of the box may be the value itself (with its full width)
##   or some transformation of it, if a conversion routine has been
##   registered.
## 
## Parameters:
##   w -- Tk pathname of widget which was clicked on
##   x -- X position (pixels) within text widget
##   y -- Y position (pixels) within text widget
##   clicks -- Number of clicks (1 for single, 2 for double, etc.)
##
## Usage:
##   scrolledtable::ValuePopup w x y clicks
##
## Comments:
##   This proc is bound to the middle mouse button; the little text widget
##   is destroyed when the middle mouse button is released.

proc scrolledtable::ValuePopup { w x y clicks } {
    set st [winfo parent $w]

    ;##- Access the state array in the namespace
    variable state$st
    ;##- Make an alias to the state array for this instance, for convenience
    upvar 0 state$st state

    set retlist [scrolledtable $st item_at $x $y]
    set valpos [lindex $retlist 0]
    set colname [string tolower [lindex $retlist 1]]
    if {[string is space $colname]} { return }
    set value [lindex $retlist 2]

    ;##- Figure out what to do with the value--convert it, or use as is
    if {[info exists state(B2Action$clicks.$colname)]} {
	set msg [$state(B2Action$clicks.$colname) $value]
    } else {
	;##- Limit the message to 1024 characters
	set msg [string range $value 0 1023]
    }
    if {$value == ""} { return }

    ;##- Figure out where to pop up the text widget,
    ;##- and what its dimensions should be
    set width [winfo width $w]
    set bboxList [$w bbox $valpos]
    if {[llength $bboxList] == 0} { return }   ;##- Off-screen
###    puts "bboxList is $bboxList"

    set bwidth [$w cget -borderwidth]
    set xshift [expr {$bwidth+[$w cget -padx]}]
    set yshift [expr {$bwidth+[$w cget -pady]}]
###    puts "width=$width, bwidth=$bwidth, xshift=$xshift, yshift=$yshift"
    set maxdispwidth [expr {int( ($width-[lindex $bboxList 0]-$xshift) / \
	    $scrolledtable::charwidth )}]
###    puts "maxdispwidth=$maxdispwidth"

    set msglen [string length $msg]
    if {$maxdispwidth >= $msglen} {
	set dispwidth $msglen
	set dispheight 1
    } else {
	set dispwidth $maxdispwidth
	set dispheight [expr {int( ($msglen-1)/$dispwidth + 1 )}]
    }

    ;##- Choose the text color for the popup
    switch $clicks {
	1 { set color "blue" }
	2 { set color "red" }
    }
	
    ;##- Create the text widget
    text $w.msg -width $dispwidth -height $dispheight -wrap char \
	    -borderwidth 0 -padx $scrolledtable::charwidth -pady 0 \
	    -foreground $color -background white
###    $w.msg insert end " "
    $w.msg insert end $msg

    ;##- Pop it up!
    place $w.msg -in $w -anchor nw -x [expr \
	    {[lindex $bboxList 0]-$scrolledtable::charwidth-$xshift-1}] \
	    -y [expr {[lindex $bboxList 1]-$yshift-1}]

    return
}

##=========================================================================
## Name: scrolledtable::ClickRow
##
## Description:
##   Routine called when the user clicks on a row number.  Selects that row,
##   unless it was already selected, in which case deselects it.
## 
## Parameters:
##   f -- Tk pathname of scrolledtable widget
##   irow -- row number which was clicked on (counting from 1)
##
## Usage:
##   scrolledtable::ClickRow f irow
##
## Comments:
##   Automatically enables or disables (as appropriate) all button widgets
##   which have been registered using "scrolledtable <name> rowbutton <widget>"

proc scrolledtable::ClickRow { f irow } {
    ;##- Access the state array in the namespace
    variable state$f
    ;##- Make an alias to the state array for this instance, for convenience
    upvar 0 state$f state

    ;##- Clear the selection tags
    $f.rownums tag remove selected 0.0 end
    $f.text tag remove selected 0.0 end

    if { $irow == $state(selectedRow) } {
	;##- This row is being deselected
	set state(selectedRow) -1
	;##- Disable all of the buttons which operate on a selected row
	foreach widget $state(rowButtons) {
	    $widget configure -state disabled
	}
    } else {
	if { $state(selectedRow) == -1 } {
	    ;##- No row was selected before
	    ;##- Enable all of the buttons which operate on a selected row
	    foreach widget $state(rowButtons) {
		$widget configure -state normal
	    }
	}
	set state(selectedRow) $irow
	$f.rownums tag add selected $irow.0 "$irow.0 lineend"
	$f.text tag add selected $irow.0 "$irow.0 lineend"
    }

    return
}

##=========================================================================
## Name: scrolledtable::ClickCol
##
## Description:
##   Routine called when the user clicks on a column heading.  Single-click
##   selects that column, unless it was already selected, in which case it
##   deselects it.  Double-click toggles the column's hidden/shown state.
## 
## Parameters:
##   f -- Tk pathname of scrolledtable widget
##   charpos -- position of the click within the colheads widgets, in
##               characters counting from the beginning of the line
##   ?clicks? -- number of clicks, 1 for single (default) or 2 for double-click
##
## Usage:
##   scrolledtable::ClickCol f charpos ?clicks?
##
## Comments:
##   Determines the column clicked on based on the position of the click.
##   Double-click forces the column to be selected, whether or not it was
##   previously selected.  This is because a double-click is also bound
##   to a commmand which toggles the hide/show state of the column.
##   Enables/disables the "Hide", "Show", and "Resize" buttons as appropriate.

proc scrolledtable::ClickCol { f charpos {clicks 1} } {

    ;##- Access the state array in the namespace
    variable state$f
    ;##- Make an alias to the state array for this instance, for convenience
    upvar 0 state$f state

    ;##- Figure out which column this is
    set selcol -1
    set icol -1
    foreach first $state(columnFirsts) last $state(columnLasts) {
	incr icol
	if { $charpos >= $first && $charpos <= $last } {
	    set selcol $icol
	}
    }
    if { $selcol == -1 } { return }

    $f.colheads tag remove selected 0.0 end
    if { $selcol != $state(selectedCol) || $clicks == 2 } {

	;##- Select the column
	set state(selectedCol) $selcol
	$f.colheads tag add selected 1.[lindex $state(columnFirsts) $selcol] \
		1.[expr {[lindex $state(columnLasts) $selcol] + 1}]

	;##- Update the message label
	$f.colinfo.message configure -state normal
	$f.colinfo.message delete 0 end
	$f.colinfo.message insert end \
		"Column selected: [lindex $state(columnNames) $selcol]"
	$f.colinfo.message configure -state $::entrydis

	;##- Enable the "hide" or "show" button, depending on whether this
	;##- column is currently shown or hidden
	if { [lindex $state(columnShown) $selcol] == 1 } {
	    $f.colinfo.hide configure -state normal
	    $f.colinfo.show configure -state disabled
	} else {
	    $f.colinfo.hide configure -state disabled
	    $f.colinfo.show configure -state normal
	}

	;##- Enable the "resize" button
	$f.colinfo.resize configure -state normal

    } else {

	;##- Deselect the column
	set state(selectedCol) -1

	;##- Update the message label
	$f.colinfo.message configure -state normal
	$f.colinfo.message delete 0 end
	$f.colinfo.message insert end "Columns"
	$f.colinfo.message configure -state $::entrydis
	    
	;##- Disable the "hide", "show", and "resize" buttons
	$f.colinfo.hide configure -state disabled
	$f.colinfo.show configure -state disabled
	$f.colinfo.resize configure -state disabled

    }

    return
}

##=========================================================================
## Name: scrolledtable::HideCol
##
## Description:
##   Routine to "hide" the selected column, i.e. shrink it down to
##   minimal width.
## 
## Parameters:
##   f -- Tk pathname of scrolledtable widget
##
## Usage:
##   scrolledtable::HideCol f
##
## Comments:
##   Calls scrolledtable::UpdateCol to do the actual resizing.
##   Updates the states of the "Hide" and "Show" buttons.

proc scrolledtable::HideCol { f } {

    ;##- Access the state array in the namespace
    variable state$f
    ;##- Make an alias to the state array for this instance, for convenience
    upvar 0 state$f state

    ;##- Get the selected column.  If none, just return
    set selcol $state(selectedCol)
    if { $selcol < 0 } { return }

    ;##- If the selected column is already hidden, just return
    if { [lindex $state(columnShown) $selcol] == 0 } { return }

    ;##- Now shrink the appropriate items in the colheads and text widgets
    scrolledtable::UpdateCol $f $selcol -1

    ;##- Mark this column as "hidden"
    set state(columnShown) [lreplace $state(columnShown) $selcol $selcol 0]

    ;##- Update the states of the Hide and Show buttons
    $f.colinfo.hide configure -state disabled
    $f.colinfo.show configure -state normal

    return
}

##=========================================================================
## Name: scrolledtable::ShowCol
##
## Description:
##   Routine to show the selected column, if it was previously hidden.
## 
## Parameters:
##   f -- Tk pathname of scrolledtable widget
##
## Usage:
##   scrolledtable::ShowCol f
##
## Comments:
##   Calls scrolledtable::UpdateCol to do the actual resizing.
##   Updates the states of the "Hide" and "Show" buttons.

proc scrolledtable::ShowCol { f } {

    ;##- Access the state array in the namespace
    variable state$f
    ;##- Make an alias to the state array for this instance, for convenience
    upvar 0 state$f state

    ;##- Get the selected column.  If none, just return
    set selcol $state(selectedCol)
    if { $selcol < 0 } { return }

    ;##- If the selected column is already shown, just return
    if { [lindex $state(columnShown) $selcol] == 1 } { return }

    ;##- Mark this column as "shown"
    set state(columnShown) [lreplace $state(columnShown) $selcol $selcol 1]

    ;##- Now expand the appropriate items in the colheads and text widgets
    scrolledtable::UpdateCol $f $selcol [lindex $state(colUseWidths) $selcol]

    ;##- Update the states of the Hide and Show buttons
    $f.colinfo.hide configure -state normal
    $f.colinfo.show configure -state disabled

    return
}

##=========================================================================
## Name: scrolledtable::ToggleCol
##
## Description:
##   Routine to toggle the hide/show state of the selected column
## 
## Parameters:
##   f -- Tk pathname of scrolledtable widget
##
## Usage:
##   scrolledtable::ToggleCol f
##
## Comments:
##   Calls either scrolledtable::HideCol or scrolledtable::ShowCol
##   as appropriate.

proc scrolledtable::ToggleCol { f } {

    ;##- Access the state array in the namespace
    variable state$f
    ;##- Make an alias to the state array for this instance, for convenience
    upvar 0 state$f state

    ;##- Get the selected column.  If none, just return
    set selcol $state(selectedCol)
    if { $selcol < 0 } { return }

    ;##- Toggle the hide/show state of the column
    if { [lindex $state(columnShown) $selcol] == 1 } {
	scrolledtable::HideCol $f
    } else {
	scrolledtable::ShowCol $f
    }

    return
}

##=========================================================================
## Name: scrolledtable::ResizeCol
##
## Description:
##   Routine to pop up a window with a slider to allow the user to modify
##   the displayed width of the selected column.
## 
## Parameters:
##   f -- Tk pathname of scrolledtable widget
##   
## Usage:
##   scrolledtable::ResizeCol f
##
## Comments:
##   Updates the width after you click OK, not continuously!
##   It would be kind of nice if you could just drag the little red bitmaps
##   in the column-headings area, but that seems tricky.

proc scrolledtable::ResizeCol { f } {

    ;##- Access the state array in the namespace
    variable state$f
    ;##- Make an alias to the state array for this instance, for convenience
    upvar 0 state$f state

    ;##- Get the selected column.  If none, just return
    set selcol $state(selectedCol)
    if { $selcol < 0 } { return }

    ;##- If there is already a sizer window, delete it
    if { [winfo exists [set f]_sizer] } { destroy [set f]_sizer }

    ;##- Look up the name and current size of this column
    set colname [lindex $state(columnNames) $selcol]
    set origsize [lindex $state(colUseWidths) $selcol]

    ;##- Create a new toplevel window, and set its name
    set tl [ toplevel [set f]_sizer ]
    wm title $tl "Resize column $colname"

    ;##- Have the user specify the new size
    set maxwidth [lindex $state(colMaxUseWidths) $selcol]
    if { $maxwidth <= 10 } {
	set tickinterval 2
    } elseif { $maxwidth <= 25 } {
	set tickinterval 5
    } elseif { $maxwidth <= 50 } {
	set tickinterval 10
    } elseif { $maxwidth <= 100 } {
	set tickinterval 20
    } elseif { $maxwidth <= 250 } {
	set tickinterval 50
    } else {
	set tickinterval [expr { 10 * (int($maxwidth/50)+1) }]
    }

    scale $tl.scale -from 0 -to $maxwidth \
	    -orient horizontal -length 300 -showvalue true \
	    -tickinterval $tickinterval -resolution 1 \
	    -label "Width of column \"$colname\""
    ;##- Set scale to current value
    $tl.scale set $origsize

    ;##- Create "OK" button.  It always updates the "use" width, but only
    ;##- updates the screen if the column is currently being shown
    button $tl.ok -text "OK" -padx 5 -pady 5 -default active \
	    -command "
    set newsize \[$tl.scale get\]
    scrolledtable::scrolledtable $f column width $selcol \$newsize
    destroy $tl"

    ;##- Bind <Return> to the OK button for convenience
    bind $tl <Return> "$tl.ok invoke"

    ;##- Create the "Cancel" button
    button $tl.cancel -text "Cancel" -padx 5 -pady 5 -command "destroy $tl"

    ;##- Pack the widgets into the toplevel window
    pack $tl.scale -side top -padx 5 -pady 5
    pack $tl.ok -side left -padx 5 -pady 5
    pack $tl.cancel -side right -padx 5 -pady 5

    return
}

##=========================================================================
## Name: scrolledtable::UpdateCol
##
## Description:
##   Routine which actually modifies the displayed width of a column.
## 
## Parameters:
##   f -- Tk pathname of scrolledtable widget
##   selcol -- column name OR column number (counting from 0)
##   newsize -- new width (in characters)
##
## Usage:
##   scrolledtable::UpdateCol f selcol newsize
##
## Comments:
##   Really just hides or reveals text using tags; does not actually delete
##   anything from, or insert anything into, the text widget.  It does have
##   to calculate the character range to be hidden/revealed separately for
##   each row, since the character indexing depends on the widths of the
##   other values in that row.

proc scrolledtable::UpdateCol { f selcol newsize } {

    ;##- Access the state array in the namespace
    variable state$f
    ;##- Make an alias to the state array for this instance, for convenience
    upvar 0 state$f state

    ;##- Use the column name to look up the column number.
    ;##- If no match is found for the name, try to interpret
    ;##- it as a column number.
    set icol [lsearch -exact $state(columnNames) $selcol]
    if { $icol == -1 } {
	if { [string is integer $selcol] } {
	    set icol $selcol
	} else {
	    return -code error -errorinfo \
		    "Error in UpdateCol: Invalid column name $selcol"
	    return
	}
    }
    set selcol $icol

    ;##- Look up information about the column
    set colname [lindex $state(columnNames) $selcol]
    set colnamewidth [string length $colname]
    set oldsize [lindex $state(colEffWidths) $selcol]
    set cfirst [lindex $state(columnFirsts) $selcol]
    set clast [lindex $state(columnLasts) $selcol]

    ;##- Access pos and width information in the namespace
    variable valpos${f}_col$selcol
    variable valwidth${f}_col$selcol
    upvar 0 valpos${f}_col$selcol valposlist
    upvar 0 valwidth${f}_col$selcol valwidthlist

    ;##- If the new size is the same as the old, just return
    if {$newsize == $oldsize} { return }

    ;##- Record the new effective width
    set state(colEffWidths) \
	    [lreplace $state(colEffWidths) $selcol $selcol $newsize]

    ;##- Calculate change in width
    set delwidth [expr {$newsize-$oldsize}]

    ;##- Enable modification of the text in the colheads widget
    $f.colheads configure -state normal

    ;##- Update the column headings and the main text area
    if { $newsize > $oldsize } {                   ;##- Making column WIDER

	;##- Reveal characters in colheads widget
	$f.colheads tag remove hidden 1.$cfirst 1.[expr {$cfirst+$newsize+1}]

	;##- Update the ending bar bitmap if necessary
	set oldoverrun [expr {$colnamewidth-$oldsize}]
	set overrun [expr {$colnamewidth-$newsize}]
	if { $oldoverrun > 0 && $overrun <= 0 } {
	    $f.colheads image create 1.$clast \
		    -image $scrolledtable::leftbar
	    $f.colheads delete 1.[expr {$clast+1}]
	} elseif { $oldsize < 0 } {
	    $f.colheads image create 1.$clast \
		    -image $scrolledtable::leftbarplus
	    $f.colheads delete 1.[expr {$clast+1}]
	}

	;##- Show characters in main text widget
	set irow 0
	foreach valpos $valposlist valwidth $valwidthlist {
	    incr irow
	    if { $oldsize == -1 } {
		if { $valwidth <= $newsize } {
		    ;##- Show entire value
		    $f.text tag remove hidden \
			    $irow.$valpos \
			    $irow.[expr {$valpos+$valwidth}]
		} else {
		    ;##- Show part of value
		    $f.text tag remove hidden \
			    $irow.$valpos \
			    $irow.[expr {$valpos+$newsize}]
		    ;##- Reveal the plus sign and turn it red
		    set ifirst $irow.[expr {$valpos+$valwidth}]
		    set ilast $irow.[expr {$valpos+$valwidth+1}]
		    $f.text tag remove hidden $ifirst $ilast
		    $f.text tag add redtext $ifirst $ilast
		}
	    } else {
		if { $valwidth <= $newsize } {
		    $f.text tag remove hidden \
			    $irow.[expr {$valpos+$oldsize}] \
			    $irow.[expr {$valpos+$valwidth}]
		    if { $valwidth > $oldsize } {
			;##- Hide the plus sign
			$f.text tag add hidden \
				$irow.[expr {$valpos+$valwidth}] \
				$irow.[expr {$valpos+$valwidth+1}]
		    }
		} else {
		    $f.text tag remove hidden \
			    $irow.[expr {$valpos+$oldsize}] \
			    $irow.[expr {$valpos+$newsize}]
		}
	    }
	}

    } else {                                      ;##- Making column NARROWER

	;##- Hide characters in colheads widget
	if {$newsize > -1} {
	    $f.colheads tag add hidden 1.[expr $cfirst+1+$newsize] \
		    1.[expr {$cfirst+1+$oldsize}]
	} else {
	    $f.colheads tag add hidden 1.$cfirst 1.[expr {$cfirst+1+$oldsize}]
	}

	;##- Update the ending bar bitmap if necessary
	set oldoverrun [expr {$colnamewidth-$oldsize}]
	set overrun [expr {$colnamewidth-$newsize}]
	if { $newsize < 0 } {
	    $f.colheads image create 1.$clast \
		    -image $scrolledtable::bothbar
	    $f.colheads delete 1.[expr {$clast+1}]
	} elseif { $oldoverrun <= 0 && $overrun > 0 } {
	    $f.colheads image create 1.$clast \
		    -image $scrolledtable::leftbarplus
	    $f.colheads delete 1.[expr {$clast+1}]
	}

	;##- Hide characters in main text widget
	set irow 0
	foreach valpos $valposlist valwidth $valwidthlist {
	    incr irow
	    if { $newsize == -1 } {
		$f.text tag add hidden \
			$irow.$valpos \
			$irow.[expr {$valpos+$valwidth+1}]
	    } elseif { $valwidth > $newsize } {
		$f.text tag add hidden \
			$irow.[expr {$valpos+$newsize}] \
			$irow.[expr {$valpos+$valwidth}]
		if { $valwidth <= $oldsize } {
		    ;##- Reveal the plus sign and turn it red
		    set ifirst $irow.[expr {$valpos+$valwidth}]
		    set ilast $irow.[expr {$valpos+$valwidth+1}]
		    $f.text tag remove hidden $ifirst $ilast
		    $f.text tag add redtext $ifirst $ilast
		}
	    }
	}

    }

    ;##- Disable modification of the text in the colheads widget
    $f.colheads configure -state disabled

    ;##- If this column is selected, update the "selected" tag
    if { $state(selectedCol) == $selcol } {
	$f.colheads tag remove selected 1.0 end
	$f.colheads tag add selected 1.$cfirst "1.$clast +1 chars"
    }

    ;##- Update the tab stops
    set curpos 1
    set tabstops [list $scrolledtable::charwidth]
    foreach coleffwidth $state(colEffWidths) {
	incr curpos [expr {$coleffwidth+2}]
	lappend tabstops [expr {$curpos*$scrolledtable::charwidth}]
    }
    $f.text configure -tabs $tabstops

    return
}

##=========================================================================
## Name: scrolledtable::MakeBitmaps
##
## Description:
##   Main routine to create the little red bitmap images which
##   separate the column names in the column-headings area.
## 
## Parameters:
##   font -- name of font used in the text widgets.
##             Must be a fixed-width font, of course!
##
## Usage:
##   scrolledtable::MakeBitmaps font
##
## Comments:
##   The bitmaps must be created at run time since different people may
##   use different fonts, intentionally or unintentionally, and it is
##   essential that the bitmaps have the same pixel dimensions as a 
##   character in the font so that the column headings line up with the
##   column values.  The width of a character is also used to calculate
##   the proper positions for the tab stops in the main text area.

proc scrolledtable::MakeBitmaps { font } {
###    puts "In MakeBitmaps with font $font"

    ;##- Determine the width and height of a character
    ;##- (Note that we must be using a fixed-width font!!!)
    variable charwidth [font measure $font X]
    variable charheight [font metrics $font -linespace]

    set width $charwidth
    set height $charheight

    ;##- Create some rectangular arrays full of zeros
    for {set x 1} {$x <= $width} {incr x} {
	for {set y 1} {$y <= $height} {incr y} {
	    set a_leftbar($x,$y) 0
	    set a_rightbar($x,$y) 0
	    set a_plus($x,$y) 0
	}
    }

    ;##----- Make the "leftbar" bitmap
    ;##- Turn on the pixels along the right edge
    for {set y 1} {$y <= $height} {incr y} {
	set a_leftbar($width,$y) 1
    }
    ;##- Turn on pixels in the top right and bottom right corners
    set x [expr {$width-1}]
    set a_leftbar($x,1) 1
    set a_leftbar($x,2) 1
    set a_leftbar($x,$height) 1
    set a_leftbar($x,[expr {$height-1}]) 1
    set x [expr {$width-2}]
    set a_leftbar($x,1) 1
    set a_leftbar($x,$height) 1

    ;##----- Make the "rightbar" bitmap
    ;##- Turn on the pixels along the left edge
    for {set y 1} {$y <= $height} {incr y} {
	set a_rightbar(1,$y) 1
    }
    ;##- Turn on pixels in the top right and bottom right corners
    set x 2
    set a_rightbar($x,1) 1
    set a_rightbar($x,2) 1
    set a_rightbar($x,$height) 1
    set a_rightbar($x,[expr {$height-1}]) 1
    set x 3
    set a_rightbar($x,1) 1
    set a_rightbar($x,$height) 1

    ;##----- Make the "plus" bitmap
    ;##- Figure out where to center the plus
    set x [expr {int(0.5*$width+0.75)}]
    set y [expr {int(0.5*$height-0.25)}]
    ;##- Now set bits
    set a_plus($x,$y) 1
    set a_plus([expr {$x-1}],$y) 1
    set a_plus([expr {$x-2}],$y) 1
    set a_plus([expr {$x+1}],$y) 1
    set a_plus([expr {$x+2}],$y) 1
    set a_plus($x,[expr {$y-1}]) 1
    set a_plus($x,[expr {$y-2}]) 1
    set a_plus($x,[expr {$y+1}]) 1
    set a_plus($x,[expr {$y+2}]) 1

    ;##----- Now OR bitmaps to make the combinations we need
    for {set x 1} {$x <= $width} {incr x} {
	for {set y 1} {$y <= $height} {incr y} {
	    set a_leftbarplus($x,$y) \
		    [expr {$a_leftbar($x,$y) | $a_plus($x,$y)}]
	    set a_bothbar($x,$y) \
		    [expr {$a_leftbar($x,$y) | $a_rightbar($x,$y) \
		    | $a_plus($x,$y)}]
	}
    }

    variable leftbar [ image create bitmap leftbar -foreground red \
	    -data [FormatBitmap leftbar $width $height] ]
    variable leftbarplus [ image create bitmap leftbarplus -foreground red \
	    -data [FormatBitmap leftbarplus $width $height] ]
    variable rightbar [ image create bitmap rightbar -foreground red \
	    -data [FormatBitmap rightbar $width $height] ]
    variable bothbar [ image create bitmap bothbar -foreground red \
	    -data [FormatBitmap bothbar $width $height] ]

    return
}

##=========================================================================
## Name: scrolledtable::FormatBitmap
##
## Description:
##   Routine to take a bitmap array of 1's and 0's, as generated by
##   scrolledtable::MakeBitmaps, and convert it to the format of a
##   bitmap definition file as required by Tk.  Returns the formatted string.
## 
## Parameters:
##   name -- name of bitmap image, AND the name of the array containing
##            the bitmap info in the scope of scrolledtable::MakeBitmaps.
##   width -- bitmap width in pixels
##   height -- bitmap height in pixels
##
## Usage:
##   scrolledtable::FormatBitmap name width height
##
## Comments:
##   The format is that produced by the "bitmap" utility, and looks like
##   a C header file.

proc scrolledtable::FormatBitmap { name width height } {
###    puts "In FormatBitmap with $name $width $height"

    ;##- Get access to the array which was passed by name
    upvar 1 a_$name array

###    ;##- Print bitmap for debugging purposes
###    for {set y 1} {$y <= $height} {incr y} {
###	for {set x 1} {$x <= $width} {incr x} {
###	    puts -nonewline $array($x,$y)
###	}
###	puts " "
###    }

    ;##- Clear the output string
    set out ""

    ;##- Output header info
    append out "#define ${name}_width $width\n"
    append out "#define ${name}_height $height\n"
    append out "static unsigned char ${name}_bits\[\] = {\n    "

    ;##- Output hexadecimal codes
    set first 1
    for {set y 1} {$y <= $height} {incr y} {
	for {set xoff 1} {$xoff <= $width} {incr xoff 8} {
	    set val 0
	    for {set x $xoff; set bit 0} {$x <= $width  && $bit < 8} \
		    {incr x; incr bit} {
		incr val [expr {$array($x,$y)*(1<<$bit)}]
	    }
	    if { $first == 0 } { append out ", " }
	    append out [format "0x%02x" $val]
	    set first 0
	}
    }

    ;##- Close the definition
    append out "\n};"

###    puts "\n$out\n"

    return $out
}

##=========================================================================
# html.tcl copied from genericAPI directory
# Changes made by Peter Shawhan (PSS):
#   Comment out a debugging puts
#   Comment out "package require http"
#   Change basesize to 10
#   Comment out buggy html::setimg call, which left file channels open
#   Add custom code to display the colored "balls", etc. in LDAS log files.
#     (By using guild's own built-in images, NOT by reading the actual gifs.)
#   Comment out code (in three places) which makes hyperlinks "live".
##=========================================================================
## ******************************************************** 
##
## Name: html.tcl
##
## Description:
## HTML rendering functions -- provide all facilties for
## rendering HTML into a text widget in browser-like
## fashion.  Somewhat buggy...
##
## Usage:
##        create a text widget (say, .t)
##  and then do:
##            html::callback .t $html"
##
##   Where $html is html text, a local file, or a URL!
##
##   To return a "used" text widget to it's original state:
##            html::reset .t
##
## Comments:
##       1. the "back" stack doesn't exist yet.
##       2. remote inline .gif's are retrieved but not
##          rendered.
##       3. it still uses the html 1.0 lib :-(
##       4. it needs to have it's placement algorithms
##          modernised.
##       ;#ol
##
## ********************************************************

;#barecode
##package require -exact http 2.3
package provide html 1.0

namespace eval html {
   set basesize 10
   set lastbaseurl {}
   }

array set html::properties {
     b      {weight bold}
     blockquote  {style italic indent 1 Trindent rindent}
     bq     {style italic indent 1 Trindent rindent}
     cite   {style italic}
     code   {family courier}
     dfn    {style italic}     
     dir    {indent 1}
     dl     {indent 1}
     em     {style italic}
     h1     {size [ expr { $html::basesize + 12 } ] weight bold}
     h2     {size [ expr { $html::basesize + 10 } ] }          
     h3     {size [ expr { $html::basesize + 8  } ] }     
     h4     {size [ expr { $html::basesize + 6  } ] }
     h5     {size [ expr { $html::basesize + 4  } ] }
     h6     {style italic}
     i      {style italic}
     kbd    {family courier weight bold}
     menu   {indent 1}
     ol     {indent 1}
     pre    {fill 0 family lucidasanstypewriter-bold-10 Tnowrap nowrap}
     samp   {family courier}          
     strong {weight bold}          
     tt     {family helvetica}
     u      {Tunderline underline}
     ul     {indent 1}
     var    {family lucida style italic}
     center {Tcenter center}
     strike {Tstrike strike}
}

set html::properties(default) {
     family     helvetica
     weight     normal
     style      roman
     size       $html::basesize
     Tcenter    {}
     Tlink      {}
     Tnowrap    {}
     Tunderline {}
     list       list
     fill       1
     indent     {}
     counter    0
     adjust     0
	 color		black
}

array set html::properties [ subst [ array get html::properties ] ]

;## html tags that insert vertical white space
array set html::insmap {
   blockquote "\n\n" /blockquote "\n"
   br    "\n"
   dd    "\n"   /dd   "\n"
   dl    "\n"   /dl   "\n"
   dt    "\n"
   form  "\n"   /form "\n"
   h1    "\n\n" /h1   "\n"
   h2    "\n\n" /h2   "\n"
   h3    "\n"   /h3   "\n\n"
   h4    "\n"   /h4   "\n"
   h5    "\n"   /h5   "\n"
   h6    "\n"   /h6   "\n"
   li    "\n"
   /dir  "\n"
   /ul   "\n"
   /ol   "\n"
   /menu "\n"
   p     "\n\n"
   pre   "\n"   /pre "\n"
}

;## tags that are list elements, that support "compact" rendering
array set html::listelem {
     ol   1   
     ul   1   
     menu 1   
     dl   1   
     dir  1
}

;## table of escape characters
array set html::escmap {
     lt     <    gt     >    quot   \"   ob     \x7b  cb    \x7d
     nbsp   \xa0 iexcl  \xa1 cent   \xa2 pound  \xa3 curren \xa4
     yen    \xa5 brvbar \xa6 sect   \xa7 uml    \xa8 copy   \xa9
     ordf   \xaa laquo  \xab not    \xac shy    \xad reg    \xae
     hibar  \xaf deg    \xb0 plusmn \xb1 sup2   \xb2 sup3   \xb3
     acute  \xb4 micro  \xb5 para   \xb6 middot \xb7 cedil  \xb8
     sup1   \xb9 ordm   \xba raquo  \xbb frac14 \xbc frac12 \xbd
     frac34 \xbe iquest \xbf Agrave \xc0 Aacute \xc1 Acirc  \xc2
     Atilde \xc3 Auml   \xc4 Aring  \xc5 AElig  \xc6 Ccedil \xc7
     Egrave \xc8 Eacute \xc9 Ecirc  \xca Euml   \xcb Igrave \xcc
     Iacute \xcd Icirc  \xce Iuml   \xcf ETH    \xd0 Ntilde \xd1
     Ograve \xd2 Oacute \xd3 Ocirc  \xd4 Otilde \xd5 Ouml   \xd6
     times  \xd7 Oslash \xd8 Ugrave \xd9 Uacute \xda Ucirc  \xdb
     Uuml   \xdc Yacute \xdd THORN  \xde szlig  \xdf agrave \xe0
     aacute \xe1 acirc  \xe2 atilde \xe3 auml   \xe4 aring  \xe5
     aelig  \xe6 ccedil \xe7 egrave \xe8 eacute \xe9 ecirc  \xea
     euml   \xeb igrave \xec iacute \xed icirc  \xee iuml   \xef
     eth    \xf0 ntilde \xf1 ograve \xf2 oacute \xf3 ocirc  \xf4
     otilde \xf5 ouml   \xf6 divide \xf7 oslash \xf8 ugrave \xf9
     uacute \xfa ucirc  \xfb uuml   \xfc yacute \xfd thorn  \xfe
     yuml   \xff amp    &	 #013	\n	  
}

;## What should a hypertext link look like?
array set html::events {
     Enter           {-borderwidth 2 -relief groove }
     Leave           {-borderwidth 2 -relief flat   }
     1               {-borderwidth 2 -relief sunken }
     ButtonRelease-1 {-borderwidth 2 -relief raised }
}
;#end

## ******************************************************** 
##
## Name: html::init 
##
## Description:
## Initialises the window and stack state for the html
## enhanced text widget.
##
## Parameters:
##
## Usage:
##
## Comments:
##

proc html::init {win} {
     upvar #0 html::$win var
     html::initState $win
     $win tag configure underline -underline 1
     $win tag configure center    -justify center
     $win tag configure nowrap    -wrap none
     $win tag configure rindent   -rmargin $var(S_tab)c
     $win tag configure strike    -overstrike 1
     $win tag configure mark      -foreground red ;# list markers
     $win tag configure list      -spacing1 3p   -spacing3 3p
     $win tag configure compact   -spacing1 0p
     # PSS commented out following line to disable hyperlinks
     ## $win tag configure link      -borderwidth 2 -foreground blue

     html::indent $win $var(S_tab)
     
     $win configure -wrap word

     # configure the text insertion point
     $win mark set $var(S_insert) 1.0

     # for horizontal rules
     $win tag configure thin -font { default 2 normal }
     $win tag configure hr   -relief sunken \
                             -borderwidth 2 \
                             -wrap none \
                             -tabs [winfo width $win]
     bind $win <Configure> {
          %W tag configure hr -tabs %w
          %W tag configure last -spacing3 %h
     }
     # PSS commented out following two lines to disable hyperlinks
     ## # generic link callback
     ## $win tag bind link <1> "html::hitlink $win %x %y"
}
## ******************************************************** 


## ******************************************************** 
##
## Name: html::indent
##
## Description:
## set the indent spacing (in cm) for lists.
## TK uses a "weird" tabbing model that causes \t to
## insert a single space if the current line position
## is past the tab setting.
##
## Parameters:
##
## Usage:
##
## Comments:
##

proc html::indent {win cm} {
     set tabs [ expr { $cm / 2.0 } ]
     $win configure -tabs ${tabs}c
     foreach i {1 2 3 4 5 6 7 8 9} {
        set tab [ expr { $i * $cm } ]
        $win tag configure indent$i -lmargin1 ${tab}c \
                                    -lmargin2 ${tab}c \
      -tabs "[ expr { $tab + $tabs } ]c [ expr { $tab + 2*$tabs } ]c"
     }
}
## ******************************************************** 


## ******************************************************** 
##
## Name: html::reset 
##
## Description:
## reset the state of window - get ready for the next page
## remove all but the font tags, and remove all form state
##
## Parameters:
##
## Usage:
##
## Comments:
##

proc html::reset {win} {

     upvar #0 html::$win var
     regsub -all { +[^L ][^ ]*} " [$win tag names] " {} tags
     catch "$win tag delete $tags"
     eval $win mark unset [$win mark names]
     $win delete 0.0 end
     $win tag configure hr -tabs [winfo width $win]

     # configure the text insertion point
     catch { $win mark set $var(S_insert) 1.0 }

     # remove form state.  If any check/radio buttons still exists, 
     # their variables will be magically re-created, and never get
     # cleaned up.
     catch unset [info vars html::$win.form*]

     html::initState $win
     return html::$win
}
## ******************************************************** 

## ******************************************************** 
##
## Name: html::initState
##
## Description:
## initialize the window's state array
##
## Parameters:
## (parameters beginning with S_ are NOT reset)
##
##  adjust_size:  global font size adjuster
##      unknown:  character to use for unknown entities
##          tab:  tab stop (in cm)
##         stop:  enabled to stop processing
##       update:  how many tags between update calls
##         tags:  number of tags processed so far
##      symbols:  Symbols to use on un-ordered lists
##
## Usage:
##
## Comments:
##

proc html::initState {win} {
     upvar #0 html::$win var
     array set tmp [array get var S_*]
     catch {unset var}
     array set var {
	 	  linecount		0
          stop          0
          tags          0
          fill          0
          list          list
          S_adjust_size 0
          S_tab         1.0
          S_unknown     \xb7
          S_update      10
          S_symbols     O*=+-o\xd7\xb0>:\xb7
          S_insert      Insert
     }
     array set var [array get tmp]
}
## ******************************************************** 


## ******************************************************** 
##
## Name: html::render 
##
## Description:
## Manages the display of HTML.  This proc is called for
## EVERY HTML tag.
##
## Parameters:
##   win:   The name of the text widget to render into
##   tag:   The html tag (in arbitrary case)
##   not:   a "/" or the empty string
##   param: The un-interpreted parameter list
##   text:  The plain text until the next html tag
##
## Usage:
##
## Comments:
## Can do with considerable optimization

proc html::render {win tag not param text} {

     upvar #0 html::$win var
     if {$var(stop)} return
     set tag [string tolower $tag]
     set text [html::preprocess $text]

     # manage compact rendering of lists
     if {[info exists html::listelem($tag)]} {
        set list "list [expr {[html::getparam $param compact] ? "compact" : "list"}]"
        } else {
        set list ""
        }

     # Allow text to be diverted to a different window (for tables)
     # this is not currently used
     if {[info exists var(divert)]} {
        set win $var(divert)
        upvar #0 html::$win var
        }

     # adjust (push or pop) tag state
     catch {html::stack $win $not "$html::properties($tag) $list"}

     # insert white space (with current font)
     # adding white space can get a bit tricky.  This isn't quite right
     set bad [catch {$win insert $var(S_insert) $html::insmap($not$tag) "space $var(font)"}]
     if {!$bad && [lindex $var(fill) end]} {
        set text [string trimleft $text]
        }

     # to fill or not to fill
	 ;## Fix : may get an empty list here 
     if {[lindex $var(fill) end]} {
        regsub -all {\s+} $text { } text
        }

     catch { html::tag $not$tag $win $param text } err

     # add the text with proper tags
     set tags [html::currtags $win]
	 incr var(linecount)
     $win insert $var(S_insert) $text $tags

	 # dont do update here to keep user input out of text widget
     # We need to do an update every so often to insure
     # interactive response.
     if {!([incr var(tags)] % $var(S_update))} {
        update idletasks 
     }
}
## ******************************************************** 

## ******************************************************** 
##
## Name: html::tag
##
## Description:
## The tag handler
## Parameters:
##
## Usage:
##
## Comments:
##

proc html::tag { tag win param text } {
     upvar #0 html::$win var
     upvar $text data
     switch -exact -- $tag {
           default { ;## tag internal to this lib
                   $win mark gravity $var(S_insert) left
                   $win insert end "\n " last
                   $win mark gravity $var(S_insert) right
                   }
          /default { ;## tag internal to this lib
                   $win delete last.first end
                   }
             title { ;## set the help window title	
                   ;## wm title [winfo parent $win] $data
                   set data ""
                   }
                hr { ;## set a horizontal rule
                   $win insert $var(S_insert) "\n" space "\n" thin "\t" \
                                               "thin hr" "\n" thin
                   }
                ol { ;## numbered list
                   set var(count$var(level)) 0
                   }
                ul { ;## unnumbered list
                   catch {unset var(count$var(level))}
                   }
              menu { ;## unsupported, sorry
                   set var(menu) ->
                   set var(compact) 1
                   }
             /menu { ;## obvious
                   catch {unset var(menu)}
                   catch {unset var(compact)}
                   }
                dt { ;## definition term portion of dl tag
                   set level $var(level)
                   incr level -1
                   $win insert $var(S_insert) "$data" \
                   "hi [lindex $var(list) end] indent$level $var(font)"
                   set data ""
                   }
                li { ;## list item
                   set level $var(level)
                   incr level -1
                   set x [string index $var(S_symbols)+-+-+-+- $level]
                   catch {set x [incr var(count$level)]}
                   catch {set x $var(menu)}
                   $win insert $var(S_insert) \t$x\t \
                   "mark [lindex $var(list) end] indent$level $var(font)"
                   }
                 a { ;## href tag handling
                   ## for a source
                   if {[html::getparam $param href]} {
                      set var(Tref) [list L:$href]
                      html::stack $win "" "Tlink link"
		      # PSS commented out following line to disable hyperlinks
                      ## html::linksetup $win $href
                      }
                   ## for a destination
                   if {[html::getparam $param name]} {
                      set var(Tname) [list N:$name]
                      html::stack $win "" "Tanchor anchor"
                      $win mark set N:$name "$var(S_insert) - 1 chars"
                      $win mark gravity N:$name left
                      if {[info exists var(goto)] && $var(goto) == $name} {
                         unset var(goto)
                         set var(going) $name
                         }
                      }
                   }
                /a {
                   if {[info exists var(Tref)]} {
                      unset var(Tref)
                      html::stack $win / "Tlink link"
                      }

                   # goto this link, then invoke the call-back.
                   if {[info exists var(going)]} {
                      $win yview N:$var(going)
                      update
                      html::wentto $win $var(going)
                      unset var(going)
                      }

                  if {[info exists var(Tname)]} {
                     unset var(Tname)
                     html::stack $win / "Tanchor anchor"
                     }
                   }
               img { ;## image tag handling
                   # get alternate text		  
                   set alt "image"
                   html::getparam $param alt
                   set alt [html::preprocess $alt]
                   set item $win.$var(tags)				   
                   set src ""
                   html::getparam $param src
# PSS commented out
###                   html::setimg $win $src $var(S_insert) $alt
# PSS added following lines to insert images for LDAS gifs
		   set image ""
		   switch $src {
		       ball_green.gif  { set image greenball  }
		       ball_yellow.gif { set image yellowball }
		       ball_orange.gif { set image orangeball }
		       ball_red.gif    { set image redball    }
		       ball_blue.gif   { set image blueball   }
		       ball_purple.gif { set image purpleball }
		       mail.gif        { set image envelope   }
		       telephone.gif   { set image telephone  }
		   }
		   if { $image != "" } {
		       $win image create $var(S_insert) -align center \
			       -image $image
		   }
	       }

			  font { ;## font 
			  	   set color ""
				   html::getparam $param color
				   set var(textcolor) $color
				   set var(textlen) [ string length $data ]
				   }
			 /font { 	
			 	    html::setcolor $win "font" 		 		
			 		set var(textcolor) black
					unset var(textlen)
				   }
           }
}
## ******************************************************** 

## ******************************************************** 
##
## Name: html::goto
##
## Description:
##
## Parameters:
##
## Usage:
##
## Comments:
## The application should call here with the fragment name
## to cause the display to go to this spot.
## If the target exists, go there (and do the callback),
## otherwise schedule the goto to happen when we see the reference.

proc html::goto {win where {callback html::wentto}} {
     upvar #0 html::$win var
     if {[regexp N:$where [$win mark names]]} {
        $win see N:$where
        update
        eval $callback $win [list $where]
        return 1
        } else {
        set var(goto) $where
        return 0
        }
}
## ********************************************************

## ******************************************************** 
##
## Name: html::wentto
##
## Description:
## Highlights a successful move to a local link
## Parameters:
##
## Usage:
##
## Comments:
##

proc html::wentto {win where {count 0} {color orange}} {
     upvar #0 html::$win var
     if {$count > 5} return
     catch {$win tag configure N:$where -foreground $color}
     update
     after 200 [list html::wentto $win $where [incr count] \
               [expr {$color=="orange" ? "" : "orange"}]]
}

## ******************************************************** 

## ******************************************************** 
##
## Name: html::setimg 
##
## Description:
## Place gifs in the text widget
##
## Parameters:
##
## Usage:
##
## Comments:
##

proc html::setimg { { win "" } { src "" } { pos "" } { alt ""  } } {

	 ;## need a symbol for log directory where gifs are 
	 set filename "/ldas_outgoing/logs/$src"
     if { [ file readable $filename ] } {
        set fsrc $filename
     } else {
        set filename html.tcl.tempfile 
        set fid [ open $filename w ]
        puts $fid [ html::geturl $src ]
        close $fid
		set fsrc $filename
     }   
 
    set gif [ image create photo -file $fsrc ]
	set ::html::gif($src) $gif
	$win tag configure bulletlist -tabs ".5c center 1c left" \
			-lmargin1 0 -lmargin2 1c
			
	$win insert $pos \t bulletlist
	$win image create $pos -padx 1 -pady 1 -image $gif
	$win insert $pos \t bulletlist
	html::imageTagButton $win $gif "$gif +1 char" $alt
	;## dont pack or image will be overlapped
	;##pack propagate [winfo parent $win] 1
}
## ******************************************************** 

## ******************************************************** 
##
## Name: html::imageTagButton 
##
## Description:
## place a tag with image to create label when cursor is over it
##
## Parameters:
##  win:	text widget
##  start:	text widget insertion start position for tag
##	end:	text widget insertion end position for tag
## Usage:
##
## Comments:
##

proc html::imageTagButton { win start end alt } {

	upvar #0 html::$win var
	
	if { ! [info exists var(imageTagId)] } {
		set var(imageTagId) 0
	} else {
		incr var(imageTagId) 1
	}
	set tag imageTag$var(imageTagId)
	$win tag configure $tag -relief flat -borderwidth 2
	$win tag configure $tag -background [$win cget -bg]
	$win tag configure $tag -foreground [$win cget -fg]

	# Bind the command to the tag
	$win tag bind $tag <Button-1> "puts {I am pressed}"
	$win tag add $tag $start $end
	# use another tag to remember the cursor
	$win tag bind $tag <Enter> \
		[ list html::changeCursor %W $tag $start $end top_left_arrow $alt %x %y]
	$win tag bind $tag <Leave> [ list html::restoreCursor %W $tag ]
}	

## ******************************************************** 
##
## Name: html::changeCursor 
##
## Description:
## change cursor when mouse moves over the tag button
##
## Parameters:
##  win:	text widget
##  start:	text widget insertion start position for tag
##	end:	text widget insertion end position for tag
##  text:	text to be displayed on label
##  x:		x coordinate under mouse
##  y:		y coordinate under mouse 
##
## Usage:
##
## Comments:
##

proc html::changeCursor { win tag start end cursor text x y } {

	upvar #0 html::$win var
	
	$win tag add cursor=[$win cget -cursor] $start $end
	$win config -cursor $cursor
    
	;## get frame parent of textsw 
	set lblframe [ winfo parent $win ]
	set label "$lblframe.lbl"
    label $label -text $text -relief ridge -bg "light yellow" -fg black \
		-font lucida
	;## Fix: adjusting $y gives flickering
	;## alt text has an escape sequence between times
    place $label -in $lblframe -x [ expr $x + 100 ] -y $y -anchor sw
	set var(altLabel) $label
}

## ******************************************************** 
##
## Name: html::restoreCursor 
##
## Description:
## restore cursor when mouse leaves the tag button
##
## Parameters:
##  win:	text widget
##
## Usage:
##
## Comments:
##

proc html::restoreCursor { win tag } {
	upvar #0 html::$win var
	regexp { cursor=([^ ]*)} [ $win tag names ] x cursor
	$win config -cursor $cursor
    destroy $var(altLabel)
	unset var(altLabel)
}



## ******************************************************** 
##
## Name: html::linksetup
##
## Description:
##
## Parameters:
##
## Usage:
##
## Comments:
##

proc html::linksetup {win href} {
     ;## escape %'s against bind's interpreter
     regsub -all {%} $href {%%} href2
     foreach i [array names html::events] {
          eval {$win tag bind  L:$href <$i>} \
               \{$win tag configure \{L:$href2\} $html::events($i)\}
          }
}
## ******************************************************** 


## ******************************************************** 
##
## Name: html::hitlink 
##
## Description:
## Generic link-hit callback.
## For button hits and hypertext links.
##
## Parameters:
##   win:   The name of the text widget to render into
##   x,y:   The cursor position at the "click"
##
## Usage:
##
## Comments:
##

proc html::hitlink {win x y} {
     set tags [$win tag names @$x,$y]
     set link [lindex $tags [lsearch -glob $tags L:*]]
     regsub L: $link {} link
     html::callback $win $link
}
## ******************************************************** 


## ******************************************************** 
##
## Name: html::callback 
##
## Description:
##
## Parameters:
##    win:  The name of the text widget to render into
##   href:  The HREF link for this <a> tag.
##
## Usage:
##
## Comments:
##

proc html::callback {win href} {
     set text {}
     
     ;## some html text
     if { [ regexp {^[\s\n\t]*<} $href ] } {
        $win configure -state normal
        html::reset $win
        html::init $win
        html::parse $href "html::render $win"
        $win configure -state disabled
        return {}
     }
	      
     ;## a local tag in the current document
     if { [ regexp {^#[^ ].+} $href ] } {     
        regsub {^#} $href {} href
        html::goto $win $href
        return {}
     }
     
     ;## a local file:
     set filename [ lindex [ glob -nocomplain $href ${href}.help */$href */${href}.help */*/$href */*/${href}.help ] 0 ]
     if { [ file readable $filename ] } {
        set fid [ open $filename r ]
        set text [ read $fid ]
        close $fid
        $win configure -state normal
        html::reset $win
        html::init $win
        if { [ regexp {^GIF8[79]a} $text ] } {
           html::setimg $win $href
        } else {
           html::parse $text "html::render $win"
        }   
        $win configure -state disabled
        return {}
     }

     ;## got here?  It must be a real URL!
     if { [ regexp {^http:} $href ] || [ llength $html::lastbaseurl ] } {
        set text [ html::geturl $href ]
        $win configure -state normal
        html::reset $win
        html::init $win
        if { [ regexp {^GIF8[79]a} $text ] } {
           html::setimg $win $href
        } else {
           html::parse $text "html::render $win"
        }   
        $win configure -state disabled
        return {}
     }
}
## ******************************************************** 

## ******************************************************** 
##
## Name: html::geturl
##
## Description:
##
## Parameters:
##
## Usage:
##
## Comments:
##

proc html::geturl { { url "" } } {
     regexp {^\{(.*)\}$} $url -> url
     regexp {^\"(.*)\"$} $url -> url
     set url [ string trim $url ]
     
     ;## reject URL's with embedded spaces
     set url_rx {^(file|http|mailto|ftp|port):/*([^ :]+):?([0-9]+)?$}
     
     if { [ regexp $url_rx $url -> protocol target port ] } {
        switch -exact -- $protocol {
           http {
                set tempfile html.tcl.tempfile
                set temp [ open $tempfile w ]           
                set token [ http::geturl $url -channel $temp ]
                close $temp
                set fid [ open $tempfile r ]
                set text [ read $fid ]
                close $fid
                file delete -- $tempfile
                set html::lastbaseurl [ file dirname $target ]
                if { [ regexp {\.} $html::lastbaseurl ] } {
                   set html::lastbaseurl $target
                }   
                return $text
                }
        default {
                return -code error "html::geturl: $protocol not supported"
                }
        } ;## end of switch
     }
     if { [ llength $html::lastbaseurl ] } {
        set url $html::lastbaseurl/$url
        set tempfile html.tcl.tempfile
        set temp [ open $tempfile w ]
        set token [ http::geturl $url -channel $temp ]
        close $temp
        set fid [ open $tempfile r ]
        set text [ read $fid ]
        close $fid
        file delete -- $tempfile
        return $text
     } else {
     return -code error "html::geturl: no base for relative URL \"$url\""
     }
}
## ******************************************************** 


## ******************************************************** 
##
## Name: html::getparam
##
## Description:
## extract a value from parameter list (this needs a re-do)
## returns "1" if the keyword is found, "0" otherwise.
##
## Parameters:
##   param: A parameter list.  It should alredy have been
##          processed to remove any entity references.
##     key: The parameter name
##     val: The variable to put the value into (use key as default)
##
## Usage:
##
## Comments:
## This can EASILY be improved!!

proc html::getparam { param key { val "" } } {
     if {$val == ""} {
        upvar $key result
        } else {
        upvar $val result
        }
     set ws "    \n\r"
    ;## look for params.  Either (') or (") are valid delimiters
    if {
       [regsub -nocase [format {.*%s[%s]*=[%s]*"([^"]*).*} $key $ws $ws] $param {\1} value] ||
       [regsub -nocase [format {.*%s[%s]*=[%s]*'([^']*).*} $key $ws $ws] $param {\1} value] ||
       [regsub -nocase [format {.*%s[%s]*=[%s]*([^%s]+).*} $key $ws $ws $ws] $param {\1} value] } {
       set result $value
       return 1
       }

     ;## now look for valueless names
     ;## I should strip out name=value pairs,
     ;## so we don't end up with "name"
     ;##inside the "value" part of some other key word - some day.
     set bad \[^a-zA-Z\]+
     if {[regexp -nocase  "$bad$key$bad" -$param-]} {
        return 1
        } else {
        return 0
        }
}
## ******************************************************** 

## ******************************************************** 
##
## Name: html::stack
##
## Description:
## Push or pop tags to/from stack.
## Each orthogonal text property has its own stack,
## stored as a list.
## The current (most recent) tag is the last item
## on the list.
## Push is {} for pushing and {/} for popping
##
## Parameters:
##
## Usage:
##
## Comments:
##

proc html::stack {win push list} {
     upvar #0 html::$win var
     array set tags $list
     if {$push == ""} {
        foreach tag [array names tags] {
             lappend var($tag) $tags($tag)
             }
        } else {
        foreach tag [array names tags] {
             # set cnt [regsub { *[^ ]+$} $var($tag) {} var($tag)]
             set var($tag) [lreplace $var($tag) end end]
             }
     }
}
## ******************************************************** 

## ******************************************************** 
##
## Name: html::currtags
##
## Description:
## extract set of current text tags.
## tags starting with T map directly to text tags,
## all others are handled specially.
## There is an application callback, html::setfont
## to allow the application to do font error handling
##
## Parameters:
##
## Usage:
##
## Comments:
##

proc html::currtags {win} {

     upvar #0 html::$win var
     set font font
     foreach i {family size weight style} {
          set $i [lindex $var($i) end]
          append font :[set $i]
          }
     set xfont [html::xfont $family $size $weight $style $var(S_adjust_size)]
     html::setfont $win $font $xfont
     set indent [llength $var(indent)]
     incr indent -1
     lappend tags $font indent$indent
     foreach tag [array names var T*] {
          lappend tags [lindex $var($tag) end]  ;# test
          }
     set var(font) $font
     set var(xfont) [$win tag cget $font -font]
     set var(level) $indent
     return $tags
}
## ******************************************************** 

## ******************************************************** 
##
## Name: html::setfont 
##
## Description:
##
## Parameters:
##
## Usage:
##
## Comments:
##

proc html::setfont {win tag font} {
	upvar #0 ::html::$win var
     catch {$win tag configure $tag -font $font} msg
}
## ******************************************************** 


## ******************************************************** 
##
## Name: html::setcolor 
##
## Description:
##	turns on color for text with font attribute specifying color
## Parameters:
##
## Usage:
##  html::setcolor $win $htag
##
## Comments:
## 

proc html::setcolor  { { win "" } { htag "font" } } {

	upvar #0 html::$win var
	set color $var(textcolor)
	set textlen [ expr $var(textlen) + 2 ]
	if	{ [ string compare $color "" ] } {
		set tag  "${htag}_${color}"
		if	{ [ catch {
			$win tag cget $tag -foreground 
			} err ] } {
			$win tag configure $tag -foreground $color 
		}
		$win tag add $tag "insert - $textlen chars" end
	}	
}
## ******************************************************** 


## ******************************************************** 
##
## Name: html::xfont
##
## Description:
##
## Parameters:
##
## Usage:
##
## Comments:
##

proc html::xfont { { family lucida } { size 12 } { weight normal } \
                { style roman } {adjust_size 0} } {
     catch {incr size $adjust_size}

     set font "${family}${size}${weight}$style"
 
     if { [ catch { font configure $font } ] } {
        catch {
               font create $font -family $family \
                                 -size   $size   \
                                 -weight $weight \
                                 -slant  $style;
              }
     }
return $font
}
## ******************************************************** 

## ******************************************************** 
##
## Name: html::parse 
##
## Description:
## Render HTML into Tcl text widget syntax
## Parameters:
##    html: A string containing an html document
##     cmd: A command to run for each html tag found
##   start: The name of the default html start/stop tags
##
## Usage:
##
## Comments:
##

proc html::parse {html {cmd html::test} {start default}} {

     regsub -all \{ $html {\&ob;} html
     regsub -all \} $html {\&cb;} html
     ;## regexp for a tag
     set exp {<(/?)([^>\s]+)\s*([^>]*)>}
     set sub "\}\n$cmd {\\2} {\\1} {\\3} \{"
     regsub -all $exp $html $sub html
     eval "$cmd {$start}   {} {} \{ $html \}"
     eval "$cmd {$start} / {} {}"
}

proc html::test { command tag slash text_after_tag } {
     puts "==> $command $tag $slash $text_after_tag"
}
## ******************************************************** 


## ******************************************************** 
##
## Name: html::preprocess
##
## Description:
##
## Parameters:
##
## Usage:
##
## Comments:
##

proc html::preprocess { text } {
     ;## maybe we are rendering something with embedded
     ;## tcl code -- declaw it!
     regsub -all {\$} $text {\\$} text
     regsub -all {\[} $text {\\[} text
     regsub -all {\]} $text {\\]} text
     ;## relpace html escape sequences with literals
     regsub -all -nocase {&([0-9a-z#]*);} $text {$html::escmap(\1)} text
     set text [ subst $text ]
     return $text
}
## ******************************************************** 

##=========================================================================
# Standard Tcl http package incorporated into this file by Peter Shawhan
# and slightly modified (search for "Peter Shawhan").
# The http package is governed by the following terms (license.terms):
# 
# This software is copyrighted by the Regents of the University of
# California, Sun Microsystems, Inc., Scriptics Corporation,
# and other parties.  The following terms apply to all files associated
# with the software unless explicitly disclaimed in individual files.
# 
# The authors hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose, provided
# that existing copyright notices are retained in all copies and that this
# notice is included verbatim in any distributions. No written agreement,
# license, or royalty fee is required for any of the authorized uses.
# Modifications to this software may be copyrighted by their authors
# and need not follow the licensing terms described here, provided that
# the new terms are clearly indicated on the first page of each file where
# they apply.
# 
# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
# 
# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
# 
# GOVERNMENT USE: If you are acquiring this software on behalf of the
# U.S. government, the Government shall have only "Restricted Rights"
# in the software and related documentation as defined in the Federal 
# Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2).  If you
# are acquiring the software on behalf of the Department of Defense, the
# software shall be classified as "Commercial Computer Software" and the
# Government shall have only "Restricted Rights" as defined in Clause
# 252.227-7013 (c) (1) of DFARs.  Notwithstanding the foregoing, the
# authors grant the U.S. Government and others acting in its behalf
# permission to use and distribute the software in accordance with the
# terms specified in this license. 
# 
##=========================================================================
# http.tcl --
#
#	Client-side HTTP for GET, POST, and HEAD commands.
#	These routines can be used in untrusted code that uses 
#	the Safesock security policy.  These procedures use a 
#	callback interface to avoid using vwait, which is not 
#	defined in the safe base.
#
# See the file "license.terms" for information on usage and
# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# Rough version history:
# 1.0	Old http_get interface
# 2.0	http:: namespace and http::geturl
# 2.1	Added callbacks to handle arriving data, and timeouts
# 2.2	Added ability to fetch into a channel
# 2.3	Added SSL support, and ability to post from a channel
#	This version also cleans up error cases and eliminates the
#	"ioerror" status in favor of raising an error

package provide http 2.3

namespace eval http {
    variable http
    array set http {
	-accept */*
	-proxyhost {}
	-proxyport {}
	-useragent {Tcl http client package 2.3}
	-proxyfilter http::ProxyRequired
    }

    variable formMap
    variable alphanumeric a-zA-Z0-9
    variable c
    variable i 0
    for {} {$i <= 256} {incr i} {
	set c [format %c $i]
	if {![string match \[$alphanumeric\] $c]} {
	    set formMap($c) %[format %.2x $i]
	}
    }
    # These are handled specially
    array set formMap {
	" " +   \n %0d%0a
    }

    variable urlTypes
    array set urlTypes {
	http	{80 ::socket}
    }

    namespace export geturl config reset wait formatQuery register unregister
    # Useful, but not exported: data size status code
}

# http::register --
#
#     See documentaion for details.
#
# Arguments:
#     proto           URL protocol prefix, e.g. https
#     port            Default port for protocol
#     command         Command to use to create socket
# Results:
#     list of port and command that was registered.

proc http::register {proto port command} {
    variable urlTypes
    set urlTypes($proto) [list $port $command]
}

# http::unregister --
#
#     Unregisters URL protocol handler
#
# Arguments:
#     proto           URL protocol prefix, e.g. https
# Results:
#     list of port and command that was unregistered.

proc http::unregister {proto} {
    variable urlTypes
    if {![info exists urlTypes($proto)]} {
	return -code error "unsupported url type \"$proto\""
    }
    set old $urlTypes($proto)
    unset urlTypes($proto)
    return $old
}

# http::config --
#
#	See documentaion for details.
#
# Arguments:
#	args		Options parsed by the procedure.
# Results:
#        TODO

proc http::config {args} {
    variable http
    set options [lsort [array names http -*]]
    set usage [join $options ", "]
    if {[llength $args] == 0} {
	set result {}
	foreach name $options {
	    lappend result $name $http($name)
	}
	return $result
    }
    regsub -all -- - $options {} options
    set pat ^-([join $options |])$
    if {[llength $args] == 1} {
	set flag [lindex $args 0]
	if {[regexp -- $pat $flag]} {
	    return $http($flag)
	} else {
	    return -code error "Unknown option $flag, must be: $usage"
	}
    } else {
	foreach {flag value} $args {
	    if {[regexp -- $pat $flag]} {
		set http($flag) $value
	    } else {
		return -code error "Unknown option $flag, must be: $usage"
	    }
	}
    }
}

# http::Finish --
#
#	Clean up the socket and eval close time callbacks
#
# Arguments:
#	token	    Connection token.
#	errormsg    (optional) If set, forces status to error.
#       skipCB      (optional) If set, don't call the -command callback.  This
#                   is useful when geturl wants to throw an exception instead
#                   of calling the callback.  That way, the same error isn't
#                   reported to two places.
#
# Side Effects:
#        Closes the socket

proc http::Finish { token {errormsg ""} {skipCB 0}} {
    variable $token
    upvar 0 $token state
    global errorInfo errorCode
    if {[string length $errormsg] != 0} {
	set state(error) [list $errormsg $errorInfo $errorCode]
	set state(status) error
    }
    catch {close $state(sock)}
    catch {after cancel $state(after)}
    if {[info exists state(-command)] && !$skipCB} {
	if {[catch {eval $state(-command) {$token}} err]} {
	    if {[string length $errormsg] == 0} {
		set state(error) [list $err $errorInfo $errorCode]
		set state(status) error
	    }
	}
	if {[info exist state(-command)]} {
	    # Command callback may already have unset our state
	    unset state(-command)
	}
    }
}

# http::reset --
#
#	See documentaion for details.
#
# Arguments:
#	token	Connection token.
#	why	Status info.
#
# Side Effects:
#       See Finish

proc http::reset { token {why reset} } {
    variable $token
    upvar 0 $token state
    set state(status) $why
    catch {fileevent $state(sock) readable {}}
    catch {fileevent $state(sock) writable {}}
    Finish $token
    if {[info exists state(error)]} {
	set errorlist $state(error)
	unset state
	eval error $errorlist
    }
}

# http::geturl --
#
#	Establishes a connection to a remote url via http.
#
# Arguments:
#       url		The http URL to goget.
#       args		Option value pairs. Valid options include:
#				-blocksize, -validate, -headers, -timeout
# Results:
#	Returns a token for this connection.
#	This token is the name of an array that the caller should
#	unset to garbage collect the state.

proc http::geturl { url args } {
    variable http
    variable urlTypes

    # Initialize the state variable, an array.  We'll return the
    # name of this array as the token for the transaction.

    if {![info exists http(uid)]} {
	set http(uid) 0
    }
    set token [namespace current]::[incr http(uid)]
    variable $token
    upvar 0 $token state
    reset $token

    # Process command options.

    array set state {
	-blocksize 	8192
	-queryblocksize 8192
	-validate 	0
	-headers 	{}
	-timeout 	0
	-type           application/x-www-form-urlencoded
	-queryprogress	{}
	state		header
	meta		{}
	currentsize	0
	totalsize	0
	querylength	0
	queryoffset	0
        type            text/html
        body            {}
	status		""
	http            ""
    }
    set options {-blocksize -channel -command -handler -headers \
	    -progress -query -queryblocksize -querychannel -queryprogress\
	    -validate -timeout -type}
    set usage [join $options ", "]
    regsub -all -- - $options {} options
    set pat ^-([join $options |])$
    foreach {flag value} $args {
	if {[regexp $pat $flag]} {
	    # Validate numbers
	    if {[info exists state($flag)] && \
		    [string is integer -strict $state($flag)] && \
		    ![string is integer -strict $value]} {
		unset $token
		return -code error "Bad value for $flag ($value), must be integer"
	    }
	    set state($flag) $value
	} else {
	    unset $token
	    return -code error "Unknown option $flag, can be: $usage"
	}
    }

    # Make sure -query and -querychannel aren't both specified

    set isQueryChannel [info exists state(-querychannel)]
    set isQuery [info exists state(-query)]
    if {$isQuery && $isQueryChannel} {
	unset $token
	return -code error "Can't combine -query and -querychannel options!"
    }

    # Validate URL, determine the server host and port, and check proxy case

    if {![regexp -nocase {^(([^:]*)://)?([^/:]+)(:([0-9]+))?(/.*)?$} $url \
	    x prefix proto host y port srvurl]} {
	unset $token
	return -code error "Unsupported URL: $url"
    }
    if {[string length $proto] == 0} {
	set proto http
	set url ${proto}://$url
    }
    if {![info exists urlTypes($proto)]} {
	unset $token
	return -code error "Unsupported URL type \"$proto\""
    }
    set defport [lindex $urlTypes($proto) 0]
    set defcmd [lindex $urlTypes($proto) 1]

    if {[string length $port] == 0} {
	set port $defport
    }
    if {[string length $srvurl] == 0} {
	set srvurl /
    }
    if {[string length $proto] == 0} {
	set url http://$url
    }
    set state(url) $url
    if {![catch {$http(-proxyfilter) $host} proxy]} {
	set phost [lindex $proxy 0]
	set pport [lindex $proxy 1]
    }

    # If a timeout is specified we set up the after event
    # and arrange for an asynchronous socket connection.

    if {$state(-timeout) > 0} {
	set state(after) [after $state(-timeout) \
		[list http::reset $token timeout]]
	set async -async
    } else {
	set async ""
    }

    # If we are using the proxy, we must pass in the full URL that
    # includes the server name.

    if {[info exists phost] && [string length $phost]} {
	set srvurl $url
	set conStat [catch {eval $defcmd $async {$phost $pport}} s]
    } else {
	set conStat [catch {eval $defcmd $async {$host $port}} s]
    }
    if {$conStat} {

	# something went wrong while trying to establish the connection
	# Clean up after events and such, but DON'T call the command callback
	# (if available) because we're going to throw an exception from here
	# instead.
	Finish $token "" 1
	cleanup $token
	return -code error $s
    }
    set state(sock) $s

    # Wait for the connection to complete

    if {$state(-timeout) > 0} {
	fileevent $s writable [list http::Connect $token]
	http::wait $token

	if {[string equal $state(status) "error"]} {
	    # something went wrong while trying to establish the connection
	    # Clean up after events and such, but DON'T call the command
	    # callback (if available) because we're going to throw an 
	    # exception from here instead.
	    set err [lindex $state(error) 0]
	    cleanup $token
	    return -code error $err
	} elseif {![string equal $state(status) "connect"]} {
	    # Likely to be connection timeout
	    return $token
	}
	set state(status) ""
    }

    # Send data in cr-lf format, but accept any line terminators

    fconfigure $s -translation {auto crlf} -buffersize $state(-blocksize)

    # The following is disallowed in safe interpreters, but the socket
    # is already in non-blocking mode in that case.

    catch {fconfigure $s -blocking off}
    set how GET
    if {$isQuery} {
	set state(querylength) [string length $state(-query)]
	if {$state(querylength) > 0} {
	    set how POST
	    set contDone 0
	} else {
	    # there's no query data
	    unset state(-query)
	    set isQuery 0
	}
    } elseif {$state(-validate)} {
	set how HEAD
    } elseif {$isQueryChannel} {
	set how POST
	# The query channel must be blocking for the async Write to
	# work properly.
	fconfigure $state(-querychannel) -blocking 1 -translation binary
	set contDone 0
    }

    if {[catch {
	puts $s "$how $srvurl HTTP/1.0"
	puts $s "Accept: $http(-accept)"
	puts $s "Host: $host"
	puts $s "User-Agent: $http(-useragent)"
	foreach {key value} $state(-headers) {
	    regsub -all \[\n\r\]  $value {} value
	    set key [string trim $key]
	    if {[string equal $key "Content-Length"]} {
		set contDone 1
		set state(querylength) $value
	    }
	    if {[string length $key]} {
		puts $s "$key: $value"
	    }
	}
	if {$isQueryChannel && $state(querylength) == 0} {
	    # Try to determine size of data in channel
	    # If we cannot seek, the surrounding catch will trap us

	    set start [tell $state(-querychannel)]
	    seek $state(-querychannel) 0 end
	    set state(querylength) \
		    [expr {[tell $state(-querychannel)] - $start}]
	    seek $state(-querychannel) $start
	}

	# Flush the request header and set up the fileevent that will
	# either push the POST data or read the response.
	#
	# fileevent note:
	#
	# It is possible to have both the read and write fileevents active
	# at this point.  The only scenario it seems to affect is a server
	# that closes the connection without reading the POST data.
	# (e.g., early versions TclHttpd in various error cases).
	# Depending on the platform, the client may or may not be able to
	# get the response from the server because of the error it will
	# get trying to write the post data.  Having both fileevents active
	# changes the timing and the behavior, but no two platforms
	# (among Solaris, Linux, and NT)  behave the same, and none 
	# behave all that well in any case.  Servers should always read thier
	# POST data if they expect the client to read their response.
		
	if {$isQuery || $isQueryChannel} {
	    puts $s "Content-Type: $state(-type)"
	    if {!$contDone} {
		puts $s "Content-Length: $state(querylength)"
	    }
	    puts $s ""
	    fconfigure $s -translation {auto binary}
	    fileevent $s writable [list http::Write $token]
	} else {
	    puts $s ""
	    flush $s
	    fileevent $s readable [list http::Event $token]
	}

	if {! [info exists state(-command)]} {

	    # geturl does EVERYTHING asynchronously, so if the user
	    # calls it synchronously, we just do a wait here.

	    wait $token
	    if {[string equal $state(status) "error"]} {
		# Something went wrong, so throw the exception, and the
		# enclosing catch will do cleanup.
		return -code error [lindex $state(error) 0]
	    }		
	}
    } err]} {
	# The socket probably was never connected,
	# or the connection dropped later.

	# Clean up after events and such, but DON'T call the command callback
	# (if available) because we're going to throw an exception from here
	# instead.
	
	# if state(status) is error, it means someone's already called Finish
	# to do the above-described clean up.
	if {[string equal $state(status) "error"]} {
	    Finish $token $err 1
	}
	cleanup $token
	return -code error $err
    }

    return $token
}

# Data access functions:
# Data - the URL data
# Status - the transaction status: ok, reset, eof, timeout
# Code - the HTTP transaction code, e.g., 200
# Size - the size of the URL data

proc http::data {token} {
    variable $token
    upvar 0 $token state
    return $state(body)
}
proc http::status {token} {
    variable $token
    upvar 0 $token state
    return $state(status)
}
proc http::code {token} {
    variable $token
    upvar 0 $token state
    return $state(http)
}
proc http::ncode {token} {
    variable $token
    upvar 0 $token state
    if {[regexp {[0-9]{3}} $state(http) numeric_code]} {
	return $numeric_code
    } else {
	return $state(http)
    }
}
proc http::size {token} {
    variable $token
    upvar 0 $token state
    return $state(currentsize)
}

proc http::error {token} {
    variable $token
    upvar 0 $token state
    if {[info exists state(error)]} {
	return $state(error)
    }
    return ""
}

# http::cleanup
#
#	Garbage collect the state associated with a transaction
#
# Arguments
#	token	The token returned from http::geturl
#
# Side Effects
#	unsets the state array

proc http::cleanup {token} {
    variable $token
    upvar 0 $token state
    if {[info exist state]} {
	unset state
    }
}

# http::Connect
#
#	This callback is made when an asyncronous connection completes.
#
# Arguments
#	token	The token returned from http::geturl
#
# Side Effects
#	Sets the status of the connection, which unblocks
# 	the waiting geturl call

proc http::Connect {token} {
    variable $token
    upvar 0 $token state
    global errorInfo errorCode

    ;##- Line added by Peter Shawhan
    catch {after cancel $state(after)}

    if {[eof $state(sock)] ||
	[string length [fconfigure $state(sock) -error]]} {
	    Finish $token "connect failed [fconfigure $state(sock) -error]" 1
    } else {
	set state(status) connect
	fileevent $state(sock) writable {}
    }
    return
}

# http::Write
#
#	Write POST query data to the socket
#
# Arguments
#	token	The token for the connection
#
# Side Effects
#	Write the socket and handle callbacks.

proc http::Write {token} {
    variable $token
    upvar 0 $token state
    set s $state(sock)
    
    # Output a block.  Tcl will buffer this if the socket blocks
    
    set done 0
    if {[catch {
	
	# Catch I/O errors on dead sockets

	if {[info exists state(-query)]} {
	    
	    # Chop up large query strings so queryprogress callback
	    # can give smooth feedback

	    puts -nonewline $s \
		    [string range $state(-query) $state(queryoffset) \
		    [expr {$state(queryoffset) + $state(-queryblocksize) - 1}]]
	    incr state(queryoffset) $state(-queryblocksize)
	    if {$state(queryoffset) >= $state(querylength)} {
		set state(queryoffset) $state(querylength)
		set done 1
	    }
	} else {
	    
	    # Copy blocks from the query channel

	    set outStr [read $state(-querychannel) $state(-queryblocksize)]
	    puts -nonewline $s $outStr
	    incr state(queryoffset) [string length $outStr]
	    if {[eof $state(-querychannel)]} {
		set done 1
	    }
	}
    } err]} {
	# Do not call Finish here, but instead let the read half of
	# the socket process whatever server reply there is to get.

	set state(posterror) $err
	set done 1
    }
    if {$done} {
	catch {flush $s}
	fileevent $s writable {}
	fileevent $s readable [list http::Event $token]
    }

    # Callback to the client after we've completely handled everything

    if {[string length $state(-queryprogress)]} {
	eval $state(-queryprogress) [list $token $state(querylength)\
		$state(queryoffset)]
    }
}

# http::Event
#
#	Handle input on the socket
#
# Arguments
#	token	The token returned from http::geturl
#
# Side Effects
#	Read the socket and handle callbacks.

 proc http::Event {token} {
    variable $token
    upvar 0 $token state
    set s $state(sock)

     if {[eof $s]} {
	Eof $token
	return
    }
    if {[string equal $state(state) "header"]} {
	if {[catch {gets $s line} n]} {
	    Finish $token $n
	} elseif {$n == 0} {
	    set state(state) body
	    if {![regexp -nocase ^text $state(type)]} {
		# Turn off conversions for non-text data
		fconfigure $s -translation binary
		if {[info exists state(-channel)]} {
		    fconfigure $state(-channel) -translation binary
		}
	    }
	    if {[info exists state(-channel)] &&
		    ![info exists state(-handler)]} {
		# Initiate a sequence of background fcopies
		fileevent $s readable {}
		CopyStart $s $token
	    }
	} elseif {$n > 0} {
	    if {[regexp -nocase {^content-type:(.+)$} $line x type]} {
		set state(type) [string trim $type]
	    }
	    if {[regexp -nocase {^content-length:(.+)$} $line x length]} {
		set state(totalsize) [string trim $length]
	    }
	    if {[regexp -nocase {^([^:]+):(.+)$} $line x key value]} {
		lappend state(meta) $key [string trim $value]
	    } elseif {[regexp ^HTTP $line]} {
		set state(http) $line
	    }
	}
    } else {
	if {[catch {
	    if {[info exists state(-handler)]} {
		set n [eval $state(-handler) {$s $token}]
	    } else {
		set block [read $s $state(-blocksize)]
		set n [string length $block]
		if {$n >= 0} {
		    append state(body) $block
		}
	    }
	    if {$n >= 0} {
		incr state(currentsize) $n
	    }
	} err]} {
	    Finish $token $err
	} else {
	    if {[info exists state(-progress)]} {
		eval $state(-progress) {$token $state(totalsize) $state(currentsize)}
	    }
	}
    }
}

# http::CopyStart
#
#	Error handling wrapper around fcopy
#
# Arguments
#	s	The socket to copy from
#	token	The token returned from http::geturl
#
# Side Effects
#	This closes the connection upon error

 proc http::CopyStart {s token} {
    variable $token
    upvar 0 $token state
    if {[catch {
	fcopy $s $state(-channel) -size $state(-blocksize) -command \
	    [list http::CopyDone $token]
    } err]} {
	Finish $token $err
    }
}

# http::CopyDone
#
#	fcopy completion callback
#
# Arguments
#	token	The token returned from http::geturl
#	count	The amount transfered
#
# Side Effects
#	Invokes callbacks

 proc http::CopyDone {token count {error {}}} {
    variable $token
    upvar 0 $token state
    set s $state(sock)
    incr state(currentsize) $count
    if {[info exists state(-progress)]} {
	eval $state(-progress) {$token $state(totalsize) $state(currentsize)}
    }
    # At this point the token may have been reset
    if {[string length $error]} {
	Finish $token $error
    } elseif {[catch {eof $s} iseof] || $iseof} {
	Eof $token
    } else {
	CopyStart $s $token
    }
}

# http::Eof
#
#	Handle eof on the socket
#
# Arguments
#	token	The token returned from http::geturl
#
# Side Effects
#	Clean up the socket

 proc http::Eof {token} {
    variable $token
    upvar 0 $token state
    if {[string equal $state(state) "header"]} {
	# Premature eof
	set state(status) eof
    } else {
	set state(status) ok
    }
    set state(state) eof
    Finish $token
}

# http::wait --
#
#	See documentaion for details.
#
# Arguments:
#	token	Connection token.
#
# Results:
#        The status after the wait.

proc http::wait {token} {
    variable $token
    upvar 0 $token state

    if {![info exists state(status)] || [string length $state(status)] == 0} {
	# We must wait on the original variable name, not the upvar alias
	vwait $token\(status)
    }

    return $state(status)
}

# http::formatQuery --
#
#	See documentaion for details.
#	Call http::formatQuery with an even number of arguments, where 
#	the first is a name, the second is a value, the third is another 
#	name, and so on.
#
# Arguments:
#	args	A list of name-value pairs.
#
# Results:
#        TODO

proc http::formatQuery {args} {
    set result ""
    set sep ""
    foreach i $args {
	append result $sep [mapReply $i]
	if {[string compare $sep "="]} {
	    set sep =
	} else {
	    set sep &
	}
    }
    return $result
}

# http::mapReply --
#
#	Do x-www-urlencoded character mapping
#
# Arguments:
#	string	The string the needs to be encoded
#
# Results:
#       The encoded string

 proc http::mapReply {string} {
    variable formMap

    # The spec says: "non-alphanumeric characters are replaced by '%HH'"
    # 1 leave alphanumerics characters alone
    # 2 Convert every other character to an array lookup
    # 3 Escape constructs that are "special" to the tcl parser
    # 4 "subst" the result, doing all the array substitutions

    set alphanumeric	a-zA-Z0-9
    regsub -all \[^$alphanumeric\] $string {$formMap(&)} string
    regsub -all \n $string {\\n} string
    regsub -all \t $string {\\t} string
    regsub -all {[][{})\\]\)} $string {\\&} string
    return [subst $string]
}

# MODIFIED VERSION OF http::ProxyRequired TO USE ENVIRONMENT VARIABLES
# Modifications made by Peter Shawhan, LIGO Laboratory, Caltech
# Modifications are (c) copyright 2002, California Institute of Technology

proc http::ProxyRequired {host} {
    variable http

    #-- Decide whether to bypass the proxy server (if one exists)
    if { [info exists ::env(HTTPPROXYBYPASS)] } {
	foreach hostpat [split $::env(HTTPPROXYBYPASS) {,}] {
	    #-- In HTTPPROXYBYPASS, one or more asterisks may be used as
	    #-- wildcards to match a single (dot-delimited) field of the
	    #-- hostname.  If an item has no asterisks, it is interpreted as a
	    #-- host or domain, i.e. it is checked against the end of the
	    #-- target hostname.
	    if { [regexp {\*} $hostpat] } {
		regsub -all {\*} $hostpat {[^\.]*} hostpat
	    } else {
		set hostpat ".*$hostpat"
	    }
	    if { [regexp -nocase "^$hostpat\$" $host] } {
		return {}
	    }
	}
    } else {
	#-- HTTPPROXYBYPASS is not set, so make a reasonable assumption:
	#-- If the destination is on a private network or else consists
	#-- of a single word, then presume that it is "local", and bypass the
	#-- proxy server (if any)
	if { [regexp {^(10|172\.(1[6-9]|2[0-9]|3[01])|192\.168|169\.254)\.} \
		$host] \
		|| ! [regexp {[:\.]} $host] } {
	    return {}
	}
    }
    #-- At this point, we plan to use the proxy server if it exists

    #-- If this application specifically configured a proxy server, use it
    if {[info exists http(-proxyhost)] && [string length $http(-proxyhost)]} {
	if {![info exists http(-proxyport)] || \
		![string length $http(-proxyport)]} {
	    set http(-proxyport) 8080
	}
	return [list $http(-proxyhost) $http(-proxyport)]
    }

    #-- Get the proxy server address from the HTTPPROXY environment variable
    if { [info exists ::env(HTTPPROXY)] } {
	if { ! [regexp {^([^:]+):(\d+)$} $::env(HTTPPROXY) - phost pport] } {
	    if { [regexp {:} $::env(HTTPPROXY)] } {
		#-- Value of HTTPPROXY environment variable is ill-formed
		return {}
	    } else {
		#-- Only the proxy host was specified, so use default port 8080
		set phost $::env(HTTPPROXY)
		set pport 8080
	    }
	}
	#-- At this point, we know hostname and port number of the proxy server
	return [list $phost $pport]
    }

    #-- If we get here, then HTTPPROXY was unset
    return {}
}
##=========================================================================
# End of http package
##=========================================================================

#%#block tcllib_md5
##=========================================================================
# md5 module from tcllib version 1.2
# Copied into guild (without modification) by Peter Shawhan
# Code in tcllib is governed by the following license (license.terms):
#
# This software is copyrighted by Ajuba Solutions and other parties.
# The following terms apply to all files associated with the software unless
# explicitly disclaimed in individual files.
# 
# The authors hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose, provided
# that existing copyright notices are retained in all copies and that this
# notice is included verbatim in any distributions. No written agreement,
# license, or royalty fee is required for any of the authorized uses.
# Modifications to this software may be copyrighted by their authors
# and need not follow the licensing terms described here, provided that
# the new terms are clearly indicated on the first page of each file where
# they apply.
# 
# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
# 
# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
# 
# GOVERNMENT USE: If you are acquiring this software on behalf of the
# U.S. government, the Government shall have only "Restricted Rights"
# in the software and related documentation as defined in the Federal 
# Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2).  If you
# are acquiring the software on behalf of the Department of Defense, the
# software shall be classified as "Commercial Computer Software" and the
# Government shall have only "Restricted Rights" as defined in Clause
# 252.227-7013 (c) (1) of DFARs.  Notwithstanding the foregoing, the
# authors grant the U.S. Government and others acting in its behalf
# permission to use and distribute the software in accordance with the
# terms specified in this license. 

##################################################
#
# md5.tcl - MD5 in Tcl
# Author: Don Libes <libes@nist.gov>, July 1999
# Version 1.2.0
#
# MD5  defined by RFC 1321, "The MD5 Message-Digest Algorithm"
# HMAC defined by RFC 2104, "Keyed-Hashing for Message Authentication"
#
# Most of the comments below come right out of RFC 1321; That's why
# they have such peculiar numbers.  In addition, I have retained
# original syntax, bugs in documentation (yes, really), etc. from the
# RFC.  All remaining bugs are mine.
#
# HMAC implementation by D. J. Hagberg <dhagberg@millibits.com> and
# is based on C code in RFC 2104.
#
# For more info, see: http://expect.nist.gov/md5pure
#
# - Don
#
# Modified by Miguel Sofer to use inlines and simple variables
##################################################

package require Tcl 8.2
namespace eval ::md5 {
}

if {![catch {package require Trf 2.0}]} {
    # Trf is available, so implement the functionality provided here
    # in terms of calls to Trf for speed.

    proc ::md5::md5 {msg} {
	string tolower [::hex -mode encode [::md5 $msg]]
    }

    # hmac: hash for message authentication

    # MD5 of Trf and MD5 as defined by this package have slightly
    # different results. Trf returns the digest in binary, here we get
    # it as hex-string. In the computation of the HMAC the latter
    # requires back conversion into binary in some places. With Trf we
    # can use omit these.

    proc ::md5::hmac {key text} {
	# if key is longer than 64 bytes, reset it to MD5(key).  If shorter, 
	# pad it out with null (\x00) chars.
	set keyLen [string length $key]
	if {$keyLen > 64} {
	    #old: set key [binary format H32 [md5 $key]]
	    set key [::md5 $key]
	    set keyLen [string length $key]
	}
    
	# ensure the key is padded out to 64 chars with nulls.
	set padLen [expr {64 - $keyLen}]
	append key [binary format "a$padLen" {}]

	# Split apart the key into a list of 16 little-endian words
	binary scan $key i16 blocks

	# XOR key with ipad and opad values
	set k_ipad {}
	set k_opad {}
	foreach i $blocks {
	    append k_ipad [binary format i [expr {$i ^ 0x36363636}]]
	    append k_opad [binary format i [expr {$i ^ 0x5c5c5c5c}]]
	}
    
	# Perform inner md5, appending its results to the outer key
	append k_ipad $text
	#old: append k_opad [binary format H* [md5 $k_ipad]]
	append k_opad [::md5 $k_ipad]

	# Perform outer md5
	#old: md5 $k_opad
	string tolower [::hex -mode encode [::md5 $k_opad]]
    }

} else {
    # Without Trf use the all-tcl implementation by Don Libes.

    # T will be inlined after the definition of md5body

    # test md5
    #
    # This proc is not necessary during runtime and may be omitted if you
    # are simply inserting this file into a production program.
    #
    proc ::md5::test {} {
	foreach {msg expected} {
	    ""
	    "d41d8cd98f00b204e9800998ecf8427e"
	    "a"
	    "0cc175b9c0f1b6a831c399e269772661"
	    "abc"
	    "900150983cd24fb0d6963f7d28e17f72"
	    "message digest"
	    "f96b697d7cb7938d525a2f31aaf161d0"
	    "abcdefghijklmnopqrstuvwxyz"
	    "c3fcd3d76192e4007dfb496cca67e13b"
	    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
	    "d174ab98d277d9f5a5611c2c9f419d9f"
	    "12345678901234567890123456789012345678901234567890123456789012345678901234567890"
	    "57edf4a22be3c955ac49da2e2107b67a"
	} {
	    puts "testing: md5 \"$msg\""
	    set computed [md5 $msg]
	    puts "expected: $expected"
	    puts "computed: $computed"
	    if {0 != [string compare $computed $expected]} {
		puts "FAILED"
	    } else {
		puts "SUCCEEDED"
	    }
	}
    }

    # time md5
    #
    # This proc is not necessary during runtime and may be omitted if you
    # are simply inserting this file into a production program.
    #
    proc ::md5::time {} {
	foreach len {10 50 100 500 1000 5000 10000} {
	    set time [::time {md5 [format %$len.0s ""]} 100]
	    regexp -- "\[0-9]*" $time msec
	    puts "input length $len: [expr {$msec/1000}] milliseconds per interation"
	}
    }

    #
    # We just define the body of md5pure::md5 here; later we
    # regsub to inline a few function calls for speed
    #

    set ::md5::md5body {

	#
	# 3.1 Step 1. Append Padding Bits
	#

	set msgLen [string length $msg]

	set padLen [expr {56 - $msgLen%64}]
	if {$msgLen % 64 > 56} {
	    incr padLen 64
	}

	# pad even if no padding required
	if {$padLen == 0} {
	    incr padLen 64
	}

	# append single 1b followed by 0b's
	append msg [binary format "a$padLen" \200]

	#
	# 3.2 Step 2. Append Length
	#

	# RFC doesn't say whether to use little- or big-endian
	# code demonstrates little-endian
	# This step limits our input to size 2^32b or 2^24B
	append msg [binary format "i1i1" [expr {8*$msgLen}] 0]
	
	#
	# 3.3 Step 3. Initialize MD Buffer
	#

	set A [expr 0x67452301]
	set B [expr 0xefcdab89]
	set C [expr 0x98badcfe]
	set D [expr 0x10325476]

	#
	# 3.4 Step 4. Process Message in 16-Word Blocks
	#

	# process each 16-word block
	# RFC doesn't say whether to use little- or big-endian
	# code says little-endian
	binary scan $msg i* blocks

	# loop over the message taking 16 blocks at a time

	foreach {X0 X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15} $blocks {

	    # Save A as AA, B as BB, C as CC, and D as DD.
	    set AA $A
	    set BB $B
	    set CC $C
	    set DD $D

	    # Round 1.
	    # Let [abcd k s i] denote the operation
	    #      a = b + ((a + F(b,c,d) + X[k] + T[i]) <<< s).
	    # [ABCD  0  7  1]  [DABC  1 12  2]  [CDAB  2 17  3]  [BCDA  3 22  4]
	    set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X0  + $T01}]  7]}]
	    set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X1  + $T02}] 12]}]
	    set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X2  + $T03}] 17]}]
	    set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X3  + $T04}] 22]}]
	    # [ABCD  4  7  5]  [DABC  5 12  6]  [CDAB  6 17  7]  [BCDA  7 22  8]
	    set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X4  + $T05}]  7]}]
	    set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X5  + $T06}] 12]}]
	    set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X6  + $T07}] 17]}]
	    set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X7  + $T08}] 22]}]
	    # [ABCD  8  7  9]  [DABC  9 12 10]  [CDAB 10 17 11]  [BCDA 11 22 12]
	    set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X8  + $T09}]  7]}]
	    set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X9  + $T10}] 12]}]
	    set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X10 + $T11}] 17]}]
	    set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X11 + $T12}] 22]}]
	    # [ABCD 12  7 13]  [DABC 13 12 14]  [CDAB 14 17 15]  [BCDA 15 22 16]
	    set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X12 + $T13}]  7]}]
	    set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X13 + $T14}] 12]}]
	    set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X14 + $T15}] 17]}]
	    set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X15 + $T16}] 22]}]

	    # Round 2.
	    # Let [abcd k s i] denote the operation
	    #      a = b + ((a + G(b,c,d) + X[k] + T[i]) <<< s).
	    # Do the following 16 operations.
	    # [ABCD  1  5 17]  [DABC  6  9 18]  [CDAB 11 14 19]  [BCDA  0 20 20]
	    set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X1  + $T17}]  5]}]
	    set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X6  + $T18}]  9]}]
	    set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X11 + $T19}] 14]}]
	    set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X0  + $T20}] 20]}]
	    # [ABCD  5  5 21]  [DABC 10  9 22]  [CDAB 15 14 23]  [BCDA  4 20 24]
	    set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X5  + $T21}]  5]}]
	    set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X10 + $T22}]  9]}]
	    set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X15 + $T23}] 14]}]
	    set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X4  + $T24}] 20]}]
	    # [ABCD  9  5 25]  [DABC 14  9 26]  [CDAB  3 14 27]  [BCDA  8 20 28]
	    set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X9  + $T25}]  5]}]
	    set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X14 + $T26}]  9]}]
	    set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X3  + $T27}] 14]}]
	    set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X8  + $T28}] 20]}]
	    # [ABCD 13  5 29]  [DABC  2  9 30]  [CDAB  7 14 31]  [BCDA 12 20 32]
	    set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X13 + $T29}]  5]}]
	    set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X2  + $T30}]  9]}]
	    set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X7  + $T31}] 14]}]
	    set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X12 + $T32}] 20]}]

	    # Round 3.
	    # Let [abcd k s t] [sic] denote the operation
	    #     a = b + ((a + H(b,c,d) + X[k] + T[i]) <<< s).
	    # Do the following 16 operations.
	    # [ABCD  5  4 33]  [DABC  8 11 34]  [CDAB 11 16 35]  [BCDA 14 23 36]
	    set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X5  + $T33}]  4]}]
	    set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X8  + $T34}] 11]}]
	    set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X11 + $T35}] 16]}]
	    set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X14 + $T36}] 23]}]
	    # [ABCD  1  4 37]  [DABC  4 11 38]  [CDAB  7 16 39]  [BCDA 10 23 40]
	    set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X1  + $T37}]  4]}]
	    set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X4  + $T38}] 11]}]
	    set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X7  + $T39}] 16]}]
	    set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X10 + $T40}] 23]}]
	    # [ABCD 13  4 41]  [DABC  0 11 42]  [CDAB  3 16 43]  [BCDA  6 23 44]
	    set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X13 + $T41}]  4]}]
	    set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X0  + $T42}] 11]}]
	    set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X3  + $T43}] 16]}]
	    set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X6  + $T44}] 23]}]
	    # [ABCD  9  4 45]  [DABC 12 11 46]  [CDAB 15 16 47]  [BCDA  2 23 48]
	    set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X9  + $T45}]  4]}]
	    set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X12 + $T46}] 11]}]
	    set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X15 + $T47}] 16]}]
	    set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X2  + $T48}] 23]}]

	    # Round 4.
	    # Let [abcd k s t] [sic] denote the operation
	    #     a = b + ((a + I(b,c,d) + X[k] + T[i]) <<< s).
	    # Do the following 16 operations.
	    # [ABCD  0  6 49]  [DABC  7 10 50]  [CDAB 14 15 51]  [BCDA  5 21 52]
	    set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X0  + $T49}]  6]}]
	    set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X7  + $T50}] 10]}]
	    set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X14 + $T51}] 15]}]
	    set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X5  + $T52}] 21]}]
	    # [ABCD 12  6 53]  [DABC  3 10 54]  [CDAB 10 15 55]  [BCDA  1 21 56]
	    set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X12 + $T53}]  6]}]
	    set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X3  + $T54}] 10]}]
	    set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X10 + $T55}] 15]}]
	    set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X1  + $T56}] 21]}]
	    # [ABCD  8  6 57]  [DABC 15 10 58]  [CDAB  6 15 59]  [BCDA 13 21 60]
	    set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X8  + $T57}]  6]}]
	    set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X15 + $T58}] 10]}]
	    set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X6  + $T59}] 15]}]
	    set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X13 + $T60}] 21]}]
	    # [ABCD  4  6 61]  [DABC 11 10 62]  [CDAB  2 15 63]  [BCDA  9 21 64]
	    set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X4  + $T61}]  6]}]
	    set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X11 + $T62}] 10]}]
	    set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X2  + $T63}] 15]}]
	    set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X9  + $T64}] 21]}]

	    # Then perform the following additions. (That is increment each
	    #   of the four registers by the value it had before this block
	    #   was started.)
	    incr A $AA
	    incr B $BB
	    incr C $CC
	    incr D $DD
	}
	# 3.5 Step 5. Output

	# ... begin with the low-order byte of A, and end with the high-order byte
	# of D.

	return [bytes $A][bytes $B][bytes $C][bytes $D]
    }

    #
    # Here we inline/regsub the functions F, G, H, I and <<< 
    #

    namespace eval ::md5 {
	#proc md5pure::F {x y z} {expr {(($x & $y) | ((~$x) & $z))}}
	regsub -all -- {\[ *F +(\$.) +(\$.) +(\$.) *\]} $md5body {((\1 \& \2) | ((~\1) \& \3))} md5body

	#proc md5pure::G {x y z} {expr {(($x & $z) | ($y & (~$z)))}}
	regsub -all -- {\[ *G +(\$.) +(\$.) +(\$.) *\]} $md5body {((\1 \& \3) | (\2 \& (~\3)))} md5body

	#proc md5pure::H {x y z} {expr {$x ^ $y ^ $z}}
	regsub -all -- {\[ *H +(\$.) +(\$.) +(\$.) *\]} $md5body {(\1 ^ \2 ^ \3)} md5body

	#proc md5pure::I {x y z} {expr {$y ^ ($x | (~$z))}}
	regsub -all -- {\[ *I +(\$.) +(\$.) +(\$.) *\]} $md5body {(\2 ^ (\1 | (~\3)))} md5body

	# bitwise left-rotate
	if {0} {
	    proc md5pure::<<< {x i} {
		# This works by bitwise-ORing together right piece and left
		# piece so that the (original) right piece becomes the left
		# piece and vice versa.
		#
		# The (original) right piece is a simple left shift.
		# The (original) left piece should be a simple right shift
		# but Tcl does sign extension on right shifts so we
		# shift it 1 bit, mask off the sign, and finally shift
		# it the rest of the way.
		
		# expr {($x << $i) | ((($x >> 1) & 0x7fffffff) >> (31-$i))}

		#
		# New version, faster when inlining
		# We replace inline (computing at compile time):
		#   R$i -> (32 - $i)
		#   S$i -> (0x7fffffff >> (31-$i))
		#

		expr { ($x << $i) | (($x >> R$i) & S$i)}
	    }
	}
	# inline <<<
	regsub -all -- {\[ *<<< +\[ *expr +({[^\}]*})\] +([0-9]+) *\]} $md5body {(([set x [expr \1]] << \2) |  (($x >> R\2) \& S\2))} md5body

	# now replace the R and S
	set map {}
	foreach i { 
	    7 12 17 22
	    5  9 14 20
	    4 11 16 23
	    6 10 15 21 
	} {
	    lappend map R$i [expr {32 - $i}] S$i [expr {0x7fffffff >> (31-$i)}]
	}
	
	# inline the values of T
	foreach \
		tName {
	    T01 T02 T03 T04 T05 T06 T07 T08 T09 T10 
	    T11 T12 T13 T14 T15 T16 T17 T18 T19 T20 
	    T21 T22 T23 T24 T25 T26 T27 T28 T29 T30 
	    T31 T32 T33 T34 T35 T36 T37 T38 T39 T40 
	    T41 T42 T43 T44 T45 T46 T47 T48 T49 T50 
	    T51 T52 T53 T54 T55 T56 T57 T58 T59 T60 
	    T61 T62 T63 T64 } \
		tVal {
	    0xd76aa478 0xe8c7b756 0x242070db 0xc1bdceee
	    0xf57c0faf 0x4787c62a 0xa8304613 0xfd469501
	    0x698098d8 0x8b44f7af 0xffff5bb1 0x895cd7be
	    0x6b901122 0xfd987193 0xa679438e 0x49b40821

	    0xf61e2562 0xc040b340 0x265e5a51 0xe9b6c7aa
	    0xd62f105d 0x2441453  0xd8a1e681 0xe7d3fbc8
	    0x21e1cde6 0xc33707d6 0xf4d50d87 0x455a14ed
	    0xa9e3e905 0xfcefa3f8 0x676f02d9 0x8d2a4c8a

	    0xfffa3942 0x8771f681 0x6d9d6122 0xfde5380c
	    0xa4beea44 0x4bdecfa9 0xf6bb4b60 0xbebfbc70
	    0x289b7ec6 0xeaa127fa 0xd4ef3085 0x4881d05
	    0xd9d4d039 0xe6db99e5 0x1fa27cf8 0xc4ac5665

	    0xf4292244 0x432aff97 0xab9423a7 0xfc93a039
	    0x655b59c3 0x8f0ccc92 0xffeff47d 0x85845dd1
	    0x6fa87e4f 0xfe2ce6e0 0xa3014314 0x4e0811a1
	    0xf7537e82 0xbd3af235 0x2ad7d2bb 0xeb86d391
	} {
	    lappend map \$$tName $tVal
	}
	set md5body [string map $map $md5body]
	

	# Finally, define the proc
	proc md5 {msg} $md5body

	# unset auxiliary variables
	unset md5body tName tVal map
    }

    proc ::md5::byte0 {i} {expr {0xff & $i}}
    proc ::md5::byte1 {i} {expr {(0xff00 & $i) >> 8}}
    proc ::md5::byte2 {i} {expr {(0xff0000 & $i) >> 16}}
    proc ::md5::byte3 {i} {expr {((0xff000000 & $i) >> 24) & 0xff}}

    proc ::md5::bytes {i} {
	format %0.2x%0.2x%0.2x%0.2x [byte0 $i] [byte1 $i] [byte2 $i] [byte3 $i]
    }

    # hmac: hash for message authentication
    proc ::md5::hmac {key text} {
	# if key is longer than 64 bytes, reset it to MD5(key).  If shorter, 
	# pad it out with null (\x00) chars.
	set keyLen [string length $key]
	if {$keyLen > 64} {
	    set key [binary format H32 [md5 $key]]
	    set keyLen [string length $key]
	}

	# ensure the key is padded out to 64 chars with nulls.
	set padLen [expr {64 - $keyLen}]
	append key [binary format "a$padLen" {}]
	
	# Split apart the key into a list of 16 little-endian words
	binary scan $key i16 blocks

	# XOR key with ipad and opad values
	set k_ipad {}
	set k_opad {}
	foreach i $blocks {
	    append k_ipad [binary format i [expr {$i ^ 0x36363636}]]
	    append k_opad [binary format i [expr {$i ^ 0x5c5c5c5c}]]
	}
    
	# Perform inner md5, appending its results to the outer key
	append k_ipad $text
	append k_opad [binary format H* [md5 $k_ipad]]

	# Perform outer md5
	md5 $k_opad
    }
}

package provide md5 1.4.1

##=========================================================================
# End of md5 package from tcllib
##=========================================================================
#%#end

##=========================================================================
# guild 4.0.0 changes: support for ldas certificates 
##=========================================================================
#=========================================================================
## procs needed to support globus channel communication to ldas
##=========================================================================

;## dialog creation
## ******************************************************** 
##
## Name: debugPuts
##
## Description:
## extra debugging
##
## Usage:
##
## Comments:

proc debugPuts { msg } {
	
	if	{ $::DEBUG_GUILD > 0 } {
    	puts stderr $msg
    } 
}

## ******************************************************** 
##
## Name: Dialog_Create 
##
## Description:
## creats a top level dialog
##
## Usage: 
##
## Comments:

proc Dialog_Create {top title args} {
	global dialog
	if [winfo exists $top] {
		switch -- [wm state $top] {
			normal {
				# Raise a buried window
				raise $top
			}
			withdrawn -
			iconic {
				# Open and restore geometry
				wm deiconify $top
				catch {wm geometry $top $dialog(geo,$top)}
			}
		}
		return 0
	} else {
		eval {toplevel $top} $args
		wm title $top $title
		return 1
	}
}

## ******************************************************** 
##
## Name: Dialog_Wait 
##
## Description:
## waits for dialog to complete
##
## Usage:
##   
## Comments:

proc Dialog_Wait {top varName {focus {}}} {
	upvar $varName var

	# Poke the variable if the user nukes the window
	bind $top <Destroy> [list set $varName cancel]

	# Grab focus for the dialog
	if {[string length $focus] == 0} {
		set focus $top
	}
	set old [focus -displayof $top]
	focus $focus
	catch {tkwait visibility $top}
	catch {grab $top}

	# Wait for the dialog to complete
	tkwait variable $varName
	catch {grab release $top}
	focus $old
}

## ******************************************************** 
##
## Name: Dialog_Dismiss 
##
## Description:
## remove dialog
##
## Usage:
##   
##
## Comments:

proc Dialog_Dismiss {top} {
	global dialog
	# Save current size and position
	catch {
		# window may have been deleted
		set dialog(geo,$top) [wm geometry $top]
		wm withdraw $top
	}
}

## ******************************************************** 
##
## Name: LabelEntry  
##
## Description:
## display a label entry widget
##
## Usage:
##   
##
## Comments:

proc LabelEntry { parent mtag args } {
	
    if	{ [ catch {
    	foreach {tag value} $args {
        	set tagname [ string trim $tag - ]
            set $tagname $value
        }

    	set frame [ frame $parent.$mtag ]
        set label [ label $frame.l$mtag -text $text -width $labelwidth -justify $labeljustify ]
        set entry [ entry $frame.e$mtag -width $width -relief sunken \
        	-textvariable $textvariable -state $state ]
        if	{ [ info exist show ] } {
        	$entry configure -show $show
        }
        pack $label -side left -anchor w
        pack $entry -side left -anchor w  -fill x -expand 1

  	} err ] } {
    	return -code error $err 
    }
    return $frame
}

if	{ ! [ string length [ info command labelframe ] ] } {
	proc labelframe { name args } {

   		foreach {tag value} $args {
        	set tagname [ string trim $tag - ]
            set $tagname $value
    	}
		set frame [ frame $name -relief $relief -borderwidth 5 ]
		set lbl [ label $frame.lbl -text $text -relief groove -borderwidth 5 ]
    	pack $lbl -side top -fill x -anchor n
     
	}
}

##=========================================================================
## Name: GetLdasProxyUser
##
## Description:
##   Get LDAS username from proxy 
##
## Comments:
##   Use ldas service certs for generic user

proc GetLdasProxyUser {} {
    debugPuts "In GetLdasProxyUser"

    #-- Check our username
    
    if { [ regexp {ldas|install|ldasdb|root|gds|controls|ops} $::tcl_platform(user) ] } {
     	set ::proxyuser ldas
        set ::proxypass X509
     	return "$::GLOBUS_DEFAULT_USER ldas"
    }
    return
}

## ******************************************************** 
##
## Name: initProxy
##
## Description:
## allow user to initialize a new proxy
##
## Usage:
##
## Comments:

proc initProxy { { valid 12:00 } } {
    debugPuts "In initProxy"

    set data ""
    if	{ ! $::doinitProxy } {
    	return
    }

    set progpath [ auto_execok grid-proxy-init ]
    if	{ ![ string length $progpath ] } {
	return -code error  "grid-proxy-init not found; unable to initialize proxy"
    }
    
    if	{ [ string length $::passphrase ] } {
	set fd [ ::open ~/.proxyinfo w ]
	puts $fd $::passphrase
	::close $fd 
	;## add -valid 
	set cmd "exec grid-proxy-init -debug -verify -valid $valid -pwstdin < ~/.proxyinfo"
	catch { eval $cmd } data
       
	file delete -force ~/.proxyinfo
	if	{ [ regexp -nocase {ERROR:} $data ] } {
	    return -code error $data
	} else {
	    return $data
	}
    } else {
    	return -code error "Bad passphrase entered to create a valid proxy."
    }
}

## ******************************************************** 
##
## Name: setDefaultProxyLife
##
## Description:
## set default proxy values
##
## Usage:
##
## Comments:

proc setDefaultProxyLife {} {
    debugPuts "In setDefaultProxyLife"

	if	{ $::proxyLifeDefault } {
    	set ::proxyLife(days) 0
        set ::proxyLife(hours) $::DEFAULT_PROXY_HOURS
    }
}

## ******************************************************** 
##
## Name: initProxyDialog
##
## Description:
## dialog to get passphrase to allow user to initialize a new proxy
##
## Usage:
##
## Comments:

proc initProxyDialog { { parent .} } {     
    debugPuts "In initProxyDialog"
 
	if	{ [ catch {
    	set ::passphrase ""
        catch { unset ::doinitProxy }
        set dlg $parent.proxyDialog 
        regsub {[\.]+} $dlg {.} dlg       
        set rc [ Dialog_Create $dlg "Create new Proxy" -borderwidth 5 ]
        if	{ $rc } {            
        	set ::passwidget  [ LabelEntry $dlg passw -text "Your pass phrase: " -labelwidth 20 -labelanchor e \
                   -textvariable ::passphrase -state normal -width 50 -labeljustify right \
                   -helptext "The passphrase associated with your proxy" -show *]
        	pack $::passwidget -side top -fill x 
        
        	;## action buttons
        	set bf1 [ frame $dlg.buttons ]
        	set butok [ button $bf1.ok -text OK -command { set ::doinitProxy 1 } ]
        	set butcancel [ button $bf1.cancel -text Cancel -command { set ::doinitProxy 0 }  ]
        	pack $butok -side left
        	pack $butcancel -side right 
        	pack $bf1 -side bottom -fill x -expand 1 -padx 20 
	    bind $dlg.passw.epassw <Return> "$bf1.ok invoke"
        }       
        Dialog_Wait $dlg ::doinitProxy $::passwidget
        Dialog_Dismiss $dlg 
       
        if	{ $::doinitProxy } {
        	set rc [ initProxy ]
        } 
    } err ] } {
    	catch { destroy .proxyDialog }
    	return -code error $err
    }

}
 
## ******************************************************** 
##
## Name: getProxyInfo
##
## Description:
## check on user proxy
##
## Usage:
##
## Comments:
##   Return codes:  0 for succuss -- also returns username and timeleft
##                  1 if no valid certificate, but can be fixed with an init
##                  2 if grid-proxy-info doesn't work (a more serious error)

proc getProxyInfo {} {
    debugPuts "In getProxyInfo"

    if	{ [ catch {
    	set rc 0
        set progpath [ auto_execok grid-proxy-info ]
        if	{ ![ string length $progpath ] } {
            return [list 2 "grid-proxy-info not found; unable to verify proxy" ]
    	}
	set data ""
    	catch { exec grid-proxy-info -identity -timeleft } data
	if { ! [string length $data] } {
	    set data "Error executing grid-proxy-info"
	    set rc 2
        } elseif { [ regexp {ERROR.+find a valid proxy} $data ] } {
	    set data "Couldn't find a valid proxy"
	    set rc 1
        } elseif { [ regexp {\n-1} $data ] } {
            set data "Your proxy has expired"
            set rc 1
	} elseif { ! [ regexp {CN=([^\d]+)\d+\n(\d+)} $data -> username timeleft ] } {
	    set data "Invalid or unrecognized proxy certificate"
	    set rc 1
        } else {
	    regsub -all {\s+} [string trim $username] "_" username
	    set data "$username $timeleft"
	    set rc 0
	}
    } err ] } {
    	return -code error "Tcl code error in getProxyInfo: $err"
    }
    debugPuts "Returning from getProxyInfo with rc=$rc, data=$data"
    return [ list $rc $data ]
}

## ******************************************************** 
##
## Name: verifyProxy
##
## Description:
## verify user proxy or uses service certs if running as ldas
## 
## Usage:
##
## Comments:

proc verifyProxy { { display 1 } } {
    debugPuts "In verifyProxy"

    set msg ""
    set lastproxyuser $::proxyuser
	
    ;## See if we should use LDAS service certificate
    GetLdasProxyUser
    debugPuts "After call to GetLdasProxyUser, proxyuser is $::proxyuser"

    if	{ [ string equal ldas $::proxyuser ] } {
        set ::passphrase x.509   
        set ::USE_GSI 1  
        set ::globusUser $::proxyuser
        set msg "Globus connection is via ldas service certificate"
        if  { $display && ! [string equal $::proxyuser $lastproxyuser] } {
            BigMessageBox -icon info -title "X509 proxy" -message $msg 
        }  
    	return $msg
    }

    if	{ [ catch {
        foreach { rc data } [ getProxyInfo ] { break }
	if { $rc == 2 } {
	    ;#-- It doesn't seem that initing will help
	    return -code error $data
	}

    	if { $rc == 1 } {
	    debugPuts "First call to initProxyDialog"
	    set rc [ initProxyDialog ]
            if	{ [ info exist ::doinitProxy ] } {
            	foreach { rc data } [ getProxyInfo ] { break }
                debugPuts "After initProxyDialog, getProxyInfo returns rc=$rc, data =$data"
                if	{ $rc } {
		    error $data 
                }
            }
        }

        ;## if user has not cancel, check the time left on proxy		
	debugPuts "Now about to check actual proxy (rc=$rc)"
        if { $rc == 0 } {
		    
	    foreach {::globusUser timeleft} $data break
	    debugPuts "user $::globusUser, timeleft $timeleft"

	    if { [ info exist ::doinitProxy ] && $::doinitProxy } {
		#-- We just initialized the proxy, so report about it
		if { ![ string length $timeleft ] } {
		    error "grid-proxy-info failed for -timeleft option."
		} elseif { $timeleft > 60 } {                
		    set walltime [ clock format [ expr $timeleft + [ clock seconds ] ] -format "%m-%d-%Y %H:%M:%S" ]
		    set msg "This proxy is valid until $walltime."
		}
	    } else {
		set msg ""
	    }
	}
        catch { unset ::passphrase }
        catch { unset ::doinitProxy }
    } err ] } {
        if	{ [ regexp -nocase -- {Bad passphrase} $err ] } {
            set message "You have entered a bad passphrase."
        } else {
            set message "Error: $err"
        }
        if  { $display } {
            set ack [ tk_messageBox -icon warning -title "X509 Proxy error" \
			  -message $message ]
        }
    	catch { unset ::passphrase } 
        set ::globusUser cancelled
        return -code error $message
    }
    if  { $display && [string length $msg] } {
        set ack [ tk_messageBox -type ok -icon info -message $msg ]
    }
    return $msg
}

## ******************************************************** 
##
## Name: verifyProxyWithRetry
##
## Description:
## verify user proxy and allows up to 3 times for entering
## correct passphrase
## 
## Usage:
##
## Comments:
## avoid using recursion in verifyProxy

proc verifyProxyWithRetry { { display 1 } { retry 3 } } {

    for { set i 0} { $i < $retry } { incr i } {
	debugPuts "In verifyProxyWithRetry, iteration $i"
        if  { [ catch {
            set rc [ verifyProxy $display ]
	    debugPuts "In verifyProxyWithRetry, verifyProxy returned $rc"
        } err ] } {
	    if { ! [ regexp -nocase -- {Bad passphrase} $err ] } {
		return -code error $err
	    }
        } else {
	    return
	}
    }

    ;## If we get here, then user entered bad passphrase too many times
    set ack [ tk_messageBox -type ok -icon error \
	    -message "Too many attempts to enter passphrase -- job cancelled" ] 
    return -code error "Too many passphrase attempts"
}


;## guild 4.0.0 support via X509 proxy
#==============================================================================

## ******************************************************** 
##
## Name: GlobusInit
##
## Description:
## initialize for use of tclglobus for X509 proxy
## 
## Usage:
##
## Comments:

proc GlobusInit {} {

    ;## set some defaults
    ;## desc=manager globus ports for receiving jobs via user cert
    set ::TCLGLOBUS_USER_PORT 10031

    ;## desc=manager globus ports for receiving jobs via host cert
    set ::TCLGLOBUS_HOST_PORT 10030

    ## desc=option to use globus tcl channel or not
    set ::ACCESS_METHOD "LDAS username"

    ;## desc=service for globus tcl channel
    set ::SERVICE_NAME ldas

    ;## desc=CA cert for globus tcl channel when using service cert
    set ::X509_CERT_DIR /etc/grid-security/certificates

    ;## desc=private key for globus tcl channel when using service cert
    set ::X509_USER_KEY /etc/grid-security/ldaskey.pem

    ;## desc=public key for globus tcl channel when using service cert
    set ::X509_USER_CERT /etc/grid-security/ldascert.pem

    ;## desc=default user for gsi sockets
    set ::GLOBUS_DEFAULT_USER Mary_O_Lei

    ;## desc=enable gsi authenication in globus channel or disable (blanks)
    set ::GSI_AUTH_ENABLED "-gsi_auth_enabled"

    ## desc=option to use gsi authenication
    set ::USE_GSI 1

    ;## desc=debug level
    if  { [ info exist ::env(DEBUG_GUILD) ] && \
	      ! [ string equal $::env(DEBUG_GUILD) 0 ] } {
	set ::DEBUG_GUILD 1
    } else {
        set ::DEBUG_GUILD 0
    }

    ;## desc=verify via host or user cert
    if	{ [ regexp {ldas} $::tcl_platform(user) ] } {
	set ::PROXY_TYPE "-host"
    	set ::globus_manager_port $::TCLGLOBUS_HOST_PORT
    } else {
	set ::globus_manager_port $::TCLGLOBUS_USER_PORT
    }

    ;## desc=tcl globus lib directory
    ;## use VDT tclglobus first, default to /ldcg last
    if  { [ info exist ::env(TCLGLOBUS_DIR) ] } {
        set  ::TCLGLOBUS_DIR $::env(TCLGLOBUS_DIR)
    } elseif { [ info exist ::env(VDT_LOCATION) ] && \
		   [ file exist $::env(VDT_LOCATION)/tclglobus/lib ] } {
	set  ::TCLGLOBUS_DIR $::env(VDT_LOCATION)/tclglobus/lib
    } elseif { $::tcl_platform(wordSize) == 8 && \
		   [ file exist /ldcg/lib/64/libtclglobus_module.so] } {
	set ::TCLGLOBUS_DIR /ldcg/lib/64
    } elseif { [ file exist /ldcg/lib/libtclglobus_module.so] } {
	set ::TCLGLOBUS_DIR /ldcg/lib
    } else {
	catch { unset ::TCLGLOBUS_DIR }
    }

    ;## GLOBUS is currently available in the location of the LDG Client install; 
    ;## There is a shell script
    ;## that users of the client run to set the globus environment

    ;## flags to indicate if tclglobus can be located
    set ::LOCATED_TCLGLOBUS 0
	 
    if { [ info exist ::TCLGLOBUS_DIR ] } {
	set ::LOCATED_TCLGLOBUS 1
	set ::globuslibs [ list globus_module \
			       globus_error \
			       globus_object \
			       gt_xio_socket_swig ]

	foreach lib $::globuslibs {
	    set lib [ file join $::TCLGLOBUS_DIR libtcl${lib}.so ]
	    if { [ file exist $lib ] } {
		debugPuts "loading $lib"
		if [catch {load $lib} err] {
		    set ::LOCATED_TCLGLOBUS 0
		    debugPuts "Error loading TclGlobus"
		    BigMessageBox -icon warning \
			-title "Error loading TclGlobus" \
			-message "Warning: failed to load TclGlobus\
                                :\n$err\n\n Continuing using old LDAS\
                                communication protocol instead of X509 proxy"
		    break
		}
	    } else {
		set ::LOCATED_TCLGLOBUS 0
		debugPuts "Unable to load tclglobus from $::TCLGLOBUS_DIR"
		BigMessageBox -icon warning -title "tclglobus error" \
		    -message "Warning: unable to load tclglobus\n\
                            from $::TCLGLOBUS_DIR\n\n Continuing using old\
                            LDAS communication protocol instead of X509 proxy"
		break                       
	    }
	}
    }

    if { $::LOCATED_TCLGLOBUS } {
	set ::ACCESS_METHOD "X509 proxy"
    }

    set ::proxyuser "UNKNOWN"

    return
}

## ******************************************************** 
##
## Name: SetPersistent
##
## Description:
## check when user selects pesistent or not as globus socket
## can only run in persistent mode 
## 
## Usage:
##
## Comments:

proc SetPersistent { value } {

	if	{ [ info exist ::ACCESS_METHOD ] } {
    	if	{ $::ACCESS_METHOD == "X509 proxy" } {
        	set ::usepersistent yes
            BigMessageBox -icon info -title "X509 Proxy" \
               -message "You must use persistent sockets with X509 proxy" \
        }
    }
}
    	
#%#end

##=========================================================================
## Name: main
##
## Description:
##   Bare code to call GuildMain
## 
## Comments:
##   OK, we've defined all the procs, including GuildMain.  Now run it!

;#barecode
GuildMain


