#!/usr/local/bin/wish

set TkGnats(lib) ./; ##TKGNATSLIB##

#
# ---- Globals
#


# This is after the some of the global defns so that the user can 
# override some of them if they wish in their .tkgnatsrc
foreach f { tkpr_library.tcl tkprprint.tcl tkprfolder.tcl tkprsort.tcl tkprhelp.tcl } {
    source $TkGnats(lib)/$f
}

# ID-NUMBER | CATEGORY | SYNOPSIS | CONFIDENTIAL |
# SEVERITY | PRIORITY | RESPONSIBLE | STATE | CLASS |
# SUBMITTER-ID | ARRIVAL-DATE | ORIGINATOR | RELEASE

# used when calling sortDialog
set Query(sort_flds) {
    Number	Category	Synopsis	Confidential 
    Severity	Priority	Responsible	State	Class 
    Submitter-Id Arrival-Date	Originator	Release
}
set Query(sort_flgs) {
    "n"		""		""  		""
    "n"		"n"		""  		"n"	"" 
    ""		""		""		""
}
set Query(default_sort_flds) {Category State Priority Severity Number}
set Query(user_sort_flds)    {}

set Query(default_sort_file) "$TkGnats(UserDir)/default-sort"
set Query(default_view_file) "$TkGnats(UserDir)/default-view"

# Query listbox headings
set list_flds_list [list  \
        Number       Id       \
        Submitter-Id Sub-Id   \
        Originator   Originator  \
        Responsible  Responsible \
        Category     Category \
        Class        Class    \
        Confidential Conf     \
        State        State    \
        Priority     Priority \
        Severity     Severity \
        Release      Rel      \
        Arrival-Date Arr-Date \
        Synopsis     Synopsis \
        ]
array set list_flds_headings $list_flds_list
array set list_flds_formats  [list \
        Number       "%5d"    \
        Submitter-Id " %-8s"  \
        Originator   " %-10s" \
        Responsible  " %-11s" \
        Category     " %-16s" \
        Class        " %-5s"  \
        Confidential " %-4s"  \
        State        " %-9s"  \
        Priority     " %-8s"  \
        Severity     " %-12s" \
        Release      " %-28s" \
        Arrival-Date " %-8s" \
        Synopsis     " %s"    \
]
array set list_flds_defaults  [list \
        Number       " Number"     \
        Submitter-Id ""  \
        Originator   ""  \
        Responsible  "Responsible" \
        Category     "Category"    \
        Class        "Class"       \
        Confidential ""  \
        State        "State"       \
        Priority     "Priority"    \
        Severity     "Severity"    \
        Release      ""  \
        Arrival-Date ""  \
        Synopsis     "Synopsis"    \
]

# set default view fields
for {set i 0} {$i < [llength $list_flds_list]} {incr i 2} {
    set x [lindex $list_flds_list $i]
    set list_flds_selected($x) $list_flds_defaults($x)
}
# override default view fields with user defaults if they exist
if {$Query(default_view_file) != ""} {
    if {[file exists $Query(default_view_file)]} {
        source $Query(default_view_file)
    }
}

# used when calling sortDialog
set Query(category_pat)    "*"
set Query(submitter_pat)   "*"
set Query(responsible_pat) "*"
set Query(tmpfile) \
    [format "/tmp/tkquery.%s.[clock format [clock seconds] -format "%d.%H.%M.%S"]" $TkGnats(LogName)]

set Query(done_msg) ""

#
# numeric --> textual mappings for some query-pr --sql fields
#
set Mappings(State)    {open analyzed suspended feedback closed}
set Mappings(Priority) {high medium low}
set Mappings(Severity) {critical serious non-critical}
set Mappings(Class)    {sw-bug doc-bug support change-request mistaken duplicate}

# List of entry widgets for traverse key binding
set Query(tlist) {}

#
# ---- Procedures
#

proc disable_listbox_menus {} {
    global Query
    .menu.print   configure -state disabled
    .menu.sel     configure -state disabled
    # current selection for maintain selection across queries, when possible
    set Query(curr_prid) -1
}
  
proc enable_listbox_menus {} {
    .menu.print   configure -state normal
    .menu.sel     configure -state normal
}
   
proc headingMsg {s} {
    .mframe.msg configure -text $s
    update
}

proc get_default_sort_criteria {} {
    global Query
    set Query(user_sort_flds) $Query(default_sort_flds)
    if {$Query(default_sort_file) != ""} {
	if {[file exists $Query(default_sort_file)]} {
            source $Query(default_sort_file)
	}
    }
}

proc prids_from_selection {} {
    set s ""
    catch {set s [selection get STRING]}
    set lines [split $s]
    set s {}
    foreach line $lines {
	set num [lindex [string trim $line "\t\n !@#\$%^&*()_-+=|\\{}\[\]:;'~`<>,.?\""] 0]
	if {[regexp {(.*/|)[0-9]+$} $num]} {
	    lappend s $num
	}
    }
    return $s
}

proc query_from_selection {} {
    global Query
    set s [prids_from_selection]
    if {"$s" == ""} {
        bell
	Msg "No PR id available in selection!"
	return;
    }
    clear_query_cmd
    set Query(done_msg) "query from selection for Id $s"
    if {[catch {perform_query_cmd prid $s} errs]} {
	tkerror "Error querying with selection\n<<<$s>>>\n$errs"
    }
}

##set wstate 1
##proc workingMsg {} {
##    global wstate TkGnats
##    case $wstate 1 {
##	.mframe.l configure -bitmap @$TkGnats(lib)/working2.xbm
##	set wstate 2
##    } 2 {
##	.mframe.l configure -bitmap @$TkGnats(lib)/working1.xbm
##	set wstate 1
##    }
##    update idletasks
##}

proc category_listbox {parent pat} {
    global Category categories Category_regexp Query

    if {![winfo exists $parent.tit]} {
        set categories [get_categories $pat]
        set wid [expr 2 + [get_max_strlen $categories]]
        
        button  $parent.tit -anchor center -text "Category:" \
                -command "helpMsg Category" -relief flat -padx 0 -pady 0 -borderwidth 0
        pack    $parent.tit -side top -fill x
        
        frame   $parent.cat
        pack    $parent.cat -side top -fill x
        
        frame   $parent.cat.l
        message $parent.cat.l.msg -anchor center -relief sunken -borderwidth 2 \
                -text "Available" -aspect 10000 -padx 0
        pack    $parent.cat.l -side left  -padx 0
        
        frame   $parent.cat.r
        message $parent.cat.r.msg -anchor center -relief sunken \
                -text "Selected" -aspect 10000 -padx 0
        pack    $parent.cat.r -side right -padx 0
        
        foreach side {l r} {
            set p $parent.cat.$side
            scrollbar $p.sb -command "$p.list yview" -borderwidth 2 \
                    -relief sunken
            listbox $p.list -yscroll "$p.sb set" -setgrid 1 \
                    -relief sunken -borderwidth 2 -width $wid -height 6
            pack $p.msg  -side top   -fill x
            pack $p.sb   -side left  -fill y
            pack $p.list -side right -fill both -expand true
        }
        
        bind $parent.cat.l.list <B1-ButtonRelease> \
                "category_add_cmd %W %y $parent.cat.r.list"
        
        bind $parent.cat.r.list <B1-ButtonRelease> \
                "category_delete_cmd %W %y $parent.cat.l.list"
        
        frame $parent.reg
        pack  $parent.reg -side top -fill x
        
        lappend Query(tlist) [singletext $parent.reg "RegExp" 10 "" 7]
        set Category_regexp $parent.reg
    } {
        # Just clear out the existing widgets
        $parent.cat.l.list delete 0 end 
        $parent.cat.r.list delete 0 end 
        unset Category
    }
    
    # Just a place holder so that Category is defined as an array
    set Category(All) ""
    
    eval $parent.cat.l.list insert end $categories
}

proc submitter_listbox {parent pat} {
    global Submitter submitters Submitter_regexp Query
    
    if {![winfo exists $parent.tit]} {
        set submitters [get_submitters $pat]
        set wid [expr 2 + [get_max_strlen $submitters]]
        
        button  $parent.tit -anchor center -text "Submitter-Id:" \
                -command "helpMsg Submitter-Id" -relief flat -padx 0 -pady 0 -borderwidth 0
        pack    $parent.tit -side top -fill x
        
        frame   $parent.sub 
        pack    $parent.sub -side top -fill x
        
        frame   $parent.sub.l
        message $parent.sub.l.msg -anchor center -relief sunken \
                -text "Available" -aspect 10000
        pack    $parent.sub.l -side left
        
        frame   $parent.sub.r
        message $parent.sub.r.msg -anchor center  -relief sunken \
                -text "Selected" -aspect 10000
        pack    $parent.sub.r -side right
        
        foreach side {l r} {
            set p $parent.sub.$side
            scrollbar $p.sb -command "$p.list yview" -borderwidth 2 \
                    -relief sunken
            listbox $p.list -yscroll "$p.sb set" -setgrid 1 \
                    -relief sunken -borderwidth 2 -width $wid -height 6
            pack $p.msg  -side top   -fill x
            pack $p.sb   -side left  -fill y
            pack $p.list -side right -fill both -expand true
        }
        
        bind $parent.sub.l.list <B1-ButtonRelease> \
                "submitter_add_cmd %W %y $parent.sub.r.list"
        
        bind $parent.sub.r.list <B1-ButtonRelease> \
                "submitter_delete_cmd %W %y $parent.sub.l.list"
        
        frame $parent.reg
        pack  $parent.reg -side top -fill x
        
        lappend Query(tlist) [singletext $parent.reg "RegExp" 10 "" 7]
        set Submitter_regexp $parent.reg
    } {
        # Just clear out the existing widgets
        $parent.sub.l.list delete 0 end 
        $parent.sub.r.list delete 0 end 
        unset Submitter
    }
    
    # Just a place holder so that Submitter is defined as an array
    set Submitter(All) ""
    
    eval $parent.sub.l.list insert end $submitters
}

proc responsible_listbox {parent pat} {
    global Responsible responsibles Responsible_regexp Query

    if {![winfo exists $parent.tit]} {
        set responsibles [get_responsibles $pat]
        set wid [expr 2 + [get_max_strlen $responsibles]]
        
        button  $parent.tit -anchor center -text "Responsible:" \
                -command "helpMsg Responsible" -relief flat -padx 0 -pady 0 -borderwidth 0
        pack    $parent.tit -side top -fill x
        
        frame   $parent.res 
        pack    $parent.res -side top -fill x
        
        frame   $parent.res.l
        message $parent.res.l.msg -anchor center -relief sunken \
                -text "Available" -aspect 10000
        pack    $parent.res.l -side left
        
        frame   $parent.res.r
        message $parent.res.r.msg -anchor center  -relief sunken \
                -text "Selected" -aspect 10000
        pack    $parent.res.r -side right
        
        foreach side {l r} {
            set p $parent.res.$side
            scrollbar $p.sb -command "$p.list yview" -borderwidth 2 \
                    -relief sunken
            listbox $p.list -yscroll "$p.sb set" -setgrid 1 \
                    -relief sunken -borderwidth 2 -width $wid -height 6
            pack $p.msg  -side top   -fill x
            pack $p.sb   -side left  -fill y
            pack $p.list -side right -fill both -expand true
        }
        
        bind $parent.res.l.list <B1-ButtonRelease> \
                "responsible_add_cmd %W %y $parent.res.r.list"
        
        bind $parent.res.r.list <B1-ButtonRelease> \
                "responsible_delete_cmd %W %y $parent.res.l.list"
        
        frame $parent.reg
        pack  $parent.reg -side top -fill x
        
        lappend Query(tlist) [singletext $parent.reg "RegExp" 10 "" 7]
        set Responsible_regexp $parent.reg
    } {
        # Just clear out the existing widgets
        $parent.res.l.list delete 0 end 
        $parent.res.r.list delete 0 end 
        unset Responsible
    }
    
    # Just a place holder so that Responsible is defined as an array
    set Responsible(All) ""
    
    eval $parent.res.l.list insert end $responsibles
}
    
proc list_item_switch_cmd {srcw y destw} {
    set idx [$srcw nearest $y]
    set ln [$srcw get $idx]
    if {"$ln" != ""} {
	$srcw delete $idx
	$destw insert end $ln
    }
    return $ln
}

proc category_add_cmd {srcw y destw} {
    global Category
    set val [list_item_switch_cmd $srcw $y $destw]
    set Category($val) $val
}

proc category_delete_cmd {srcw y destw} {
    global Category
    set val [list_item_switch_cmd $srcw $y $destw]
    if {"$val" != ""} {
	unset Category($val)
    }
    sort_listbox $destw
}

proc submitter_add_cmd {srcw y destw} {
    global Submitter
    set val [list_item_switch_cmd $srcw $y $destw]
    set Submitter($val) $val
}

proc submitter_delete_cmd {srcw y destw} {
    global Submitter
    set val [list_item_switch_cmd $srcw $y $destw]
    if {"$val" != ""} {
	unset Submitter($val)
    }
    sort_listbox $destw
}

proc responsible_add_cmd {srcw y destw} {
    global Responsible
    set val [list_item_switch_cmd $srcw $y $destw]
    set Responsible($val) $val
}

proc responsible_delete_cmd {srcw y destw} {
    global Responsible
    set val [list_item_switch_cmd $srcw $y $destw]
    if {"$val" != ""} {
	unset Responsible($val)
    }
    sort_listbox $destw
}

proc set_query_view_heading {} {
    global  list_flds_selected list_flds_formats list_flds_format list_flds_list \
            list_flds_headings list_flds_heading
    set list_flds_heading "       Id"
    for {set i 2} {$i < [llength $list_flds_list]} {incr i 2} {
        set x [lindex $list_flds_list $i]
        if {$list_flds_selected($x) != ""} {
            append list_flds_heading [format $list_flds_formats($x) $list_flds_headings($x)]
        }
    }
}

proc set_query_view_fields {} {
    global Query list_flds_selected list_flds_heading
    set_query_view_heading
    # save default-view file
    set    sfout [open $Query(default_view_file) w]
    puts  $sfout "global list_flds_selected"
    puts  $sfout "array set list_flds_selected \{[array get list_flds_selected]\}"
    close $sfout
    .qlb.query.label configure -text $list_flds_heading
    perform_query_cmd
}

proc query_listbox {p} {
    global Category "" list_flds_heading
    set lboxwidth  100
    frame $p.query 
    pack  $p.query -side top -fill both -expand true
    set_query_view_heading
    label   $p.query.label -font fixed -anchor w -text $list_flds_heading
    listbox $p.query.list  -font fixed -relief sunken -borderwidth 2 -setgrid 1 \
            -xscroll "$p.query.sbx set" -yscroll "$p.query.sby set" \
            -width ${lboxwidth} -height 12 -exportselection false
    scrollbar $p.query.sby -command "$p.query.list yview" -borderwidth 2 -orient vertical
    
    # Create padding based on the y scrollbar width and border
    frame $p.query.bottom
    scrollbar $p.query.sbx -command "$p.query.list xview" -borderwidth 2 -orient horizontal
    set pad [expr [$p.query.sby cget -width] + 2 * \
            ([$p.query.sby cget -bd] + [$p.query.sby cget -highlightthickness])]
    frame $p.query.pad -width $pad -height $pad

    pack  $p.query.label  -side top    -fill x 
    pack  $p.query.pad    -in $p.query.bottom -side left
    pack  $p.query.sbx    -in $p.query.bottom -side bottom -fill x
    pack  $p.query.bottom -side bottom -fill x 

    pack  $p.query.sby    -side left   -fill y 
    pack  $p.query.list   -side right  -fill both -expand true

    bind  $p.query.list <Double-Button-1> "selection_View_Formatted_cmd %W"
    bind  $p.query.list <Control-l> "%W xview 0"
    bind  $p.query.list <KeyRelease-Left> "%W xview 0"
    bind  $p.query.list <KeyRelease-Right> "%W xview [expr $lboxwidth/2]"
    bind  $p.query.list <Control-r> "%W xview [expr $lboxwidth/2]"

    return $p.query.list
}

#
# ---- Callbacks
#
proc folder_view_query_cmd {} {
    tkprfolder_dialog .tkprqueryfolder query "Saved Query Commands"
}

proc folder_save_query_cmd {} {
    save_query_cmd
    build_query_menu
}

proc folder_view_sort_cmd {} {
    tkprfolder_dialog .tkprsortfolder sort "Saved Sort Commands"
}

proc folder_save_sort_cmd {{fname ""}} {
    global Tkprfolder Query
    if {$fname == ""} {
        while {"$fname" == ""} {
            ###set fname [file tail [get_save_file_name Sort]]
            set fname [get_save_file_name Sort]
            if {"$fname" == ""} {
                headingMsg "Save cancelled"
                return
            }
	    regexp $Tkprfolder(foldernameregexp) $fname match
	    if {$fname != $match} {
		Msg "Folder names must be composed only of letters, numbers, underscores and periods."
		return
	    }
            if {[file exists $Tkprfolder(user_sort_dir)/$fname]} {
                bell
                if {[tk_dialog .tkprfolder_delete "Confirm_Save" "$fname already exists" \
                        "warning" -1 "Overwrite" "Cancel"] != 0} {
                    set fname ""
                }
            }
        }
        set fname $Tkprfolder(user_sort_dir)/$fname
    }
    save_sort_fields $fname $Query(user_sort_flds)
    build_sort_menu
}

proc pridfromsummaryline {ln} {
    scan $ln "%d" prid
    return $prid
}

proc selln {w} {
    set x  [$w curselection]
    if {[llength $x] == 0} {
	return ""
    } else {
	return [$w get [lindex $x 0]]
    }
}

proc selection_Remove_cmd {w} {
    global Query
    if {[$w curselection] != ""} {
        $w delete [$w curselection]
        $w selection set active
    }
    if {[$w size] == 0} {
        disable_listbox_menus
    }
}

proc selection_Delete_cmd {w} {
    global TkGnats
    set ln [selln $w]
    if {"$ln" != ""} {
	set prid [pridfromsummaryline $ln]
        . configure -cursor watch
	headingMsg "Please Wait..."
        set result [delete_pr $prid]
        if {[string first deleted $result] >= 0} {
            # Successful deletion
            $w delete [$w curselection]
            $w selection set active
            headingMsg "$result"
        } else {
            if {"$result" != ""} {
                tk_dialog .tkquerypr_delete "TkQuery Delete" $result "info" -1 "OK"
            }
            headingMsg "Delete failed."
        }
        . configure -cursor left_ptr
    }
    if {[$w size] == 0} {
        disable_listbox_menus
    }
}

proc selection_Email_cmd {w} {
    global TkGnats
    set ln [selln $w]
    if {"$ln" != ""} {
        . configure -cursor watch
	headingMsg "Please Wait..."
	set prid [pridfromsummaryline $ln]
        set fin [open "|query-pr --full [file tail $prid]" r]
        parsepr $fin flds
        close $fin
        email_originator [ftrim $flds(Reply-To)] [ftrim $flds(>Responsible)] \
                [ftrim $flds(From)] [ftrim $flds(>Category)]/$prid [ftrim $flds(>Synopsis)]
	after 2250 {headingMsg " " ; . configure -cursor left_ptr}
    }
}
#                [lrange [split [ftrim $flds(>Originator)]] 0 0]

proc selection_Edit_cmd {w} {
    global TkGnats
    set ln [selln $w]
    if {"$ln" != ""} {
	headingMsg "Please Wait..."
        . configure -cursor watch
	set prid [pridfromsummaryline $ln]
	exec sh -c [format $TkGnats(pr_editor) $prid] &
	schedule_reap
	after 2250 {headingMsg " " ; . configure -cursor left_ptr}
    }
}

proc selection_Print_cmd {w} {
    set ln [selln $w]
    if {"$ln" != ""} {
	headingMsg "Please Wait..."
        . configure -cursor watch
	set prid [pridfromsummaryline $ln]
	fullreport $prid
	schedule_reap
	after 2250 {headingMsg " " ; . configure -cursor left_ptr}
    }
}

proc selection_View_Formatted_cmd {w} {
    global TkGnats
    set ln [selln $w]
    if {"$ln" != ""} {
	headingMsg "Please Wait..."
        . configure -cursor watch
	set prid [pridfromsummaryline $ln]
        ### FIXIT wish path?
###	exec wish $TkGnats(lib)/tkviewpr.tcl $prid &
	exec tkviewpr $prid &
	schedule_reap
	after 2250 {headingMsg " " ; . configure -cursor left_ptr}
    }
}

proc selection_View_Raw_cmd {w} {
    set ln [selln $w]
    if {"$ln" != ""} {
        . configure -cursor watch
	headingMsg "Please Wait..."
	set prid [pridfromsummaryline $ln]
	exec tkviewpr $prid raw &
	schedule_reap
	after 2250 {headingMsg " " ; . configure -cursor left_ptr}
    }
}

proc build_query_header {procname} {
    global TkGnats Query
    set    Query(query_pr_opts) "-i"
    set    Query(default__query) "proc $procname \{f\} \{\n"
    append Query(default__query) "\tupvar 1 \$f flds\n"
    append Query(default__query) "\tif \{\n"
}

proc build_regex_query_qualifier {subclauseop type tag lst regexp} {
    global Query
    # set AND or OR subclaus operator
    switch -exact -- $subclauseop -and { 
	set subclauseop & 
    } -or {
	set subclauseop |
    }
    set subclausestr   ""
    set subclauseopstr ""
    foreach data $lst {
	set data [string trim $data " \n\t"]
	if {"$data" == ""} {
	    continue
	}
	# first clause: put in leading option stuff
	if {"$subclausestr" == ""} {
	    set subclausestr [format "--%s=" [string tolower $tag]]
	}
	switch -exact -- $type -exact {
	    append subclausestr "$subclauseopstr^$data\$"
	} -glob {
	    append subclausestr "$subclauseopstr$data"
	}
	set subclauseopstr $subclauseop
    }
    if {"$subclausestr" == ""} {
	# no clauses were written
        if {"$regexp" != "" } {
            lappend Query(query_pr_opts) [format "--%s=" [string tolower $tag]]$regexp
        }
    } {
        if {"$regexp" != "" } {
            append subclausestr "|$regexp"
        }
        lappend Query(query_pr_opts) "$subclausestr"
    }
}

# This isn't currently used: query-pr can handle all fields now, as of beta 3.102.
proc build_dumb_query_qualifier {subclauseop type tag lst} {
    # puts "build dumb! subclauseop=$subclauseop type=$type tag=$tag lst=$lst"
    # set AND or OR subclaus operator
    switch -exact -- $subclauseop -and { 
	set subclauseop && 
    } -or {
	set subclauseop ||
    }
    set subclausestr ""

    foreach data $lst {
	set data [string trim $data " \n\t"]
	if {"$data" == ""} {
	    continue
	}
	# first clause , put in the leading parens
	if {"$subclausestr" == ""} {
	    append Query(default__query) "\t\t"
	    append Query(default__query) "( "
	}
	switch -exact -- $type -exact {
	    append Query(default__query) \
	 "$subclausestr ( \$flds($tag) == \"$data\" ) " nonewline
	} -glob {
	    append Query(default__query) \
		    "$subclausestr ( \[info exists flds($tag)\] && \
		    \[regexp -nocase -- \{$data\} \$flds($tag) \] ) " nonewline
	}
	set subclausestr "\\\n\t\t\t$subclauseop"
    }

    ##### "$subclausestr ( \[string match \{$data\} \$flds($tag) \] ) "

    if {"$subclausestr" == ""} {
	# no clauses were written so just return
	return
    }

    append Query(default__query) ") && \\"
}
 
proc build_mtime_query_qualifier {mtime} {
    global TkGnats GNATS_ROOT Query

    set mtime [expr [clock seconds] - $mtime * 24 * 60 * 60]

    append Query(default__query) "\t\t( \[file exists $GNATS_ROOT/\$flds(Category)/\$flds(Number)\] && \\\n"

    append Query(default__query) "\t\t  \[file mtime  $GNATS_ROOT/\$flds(Category)/\$flds(Number)\] <= $mtime ) && \\\n"

}

proc build_query_trailer {} {
    global Query
    append Query(default__query) "\t\t1==1 \} \{\n"
    append Query(default__query) "\t\treturn 1\n\t\}\n"
    append Query(default__query) "\treturn 0\n"
    append Query(default__query) \}
}

proc save_query_listboxes { sfout wn l s } {
    global ${s}_regexp
    puts $sfout "global $l"
    puts $sfout ".eboxs.$wn.l.list delete 0 end"
    puts $sfout ".eboxs.$wn.r.list delete 0 end"
    puts $sfout "foreach a \$$l \{"
    puts $sfout "    if \{\[lsearch \[array names $s\] \$a\] < 0\} \{"
    puts $sfout "        .eboxs.$wn.l.list insert end \$a"
    puts $sfout "    \} \{"
    puts $sfout "        .eboxs.$wn.r.list insert end \$a"
    puts $sfout "    \}"
    puts $sfout "\}"
    if {[textget RegExp [set [set s]_regexp]] != ""} {
        puts $sfout \
                "textset RegExp \"[textget RegExp [set [set s]_regexp]]\" [set [set s]_regexp]"
    }
}

proc get_save_file_name {title} {
    set origp [entryDialog "Enter name of file to save $title into:\n\n(Hint: underscores in name are replaced\nwith blanks for nice looking menu names)"]
    if {"$origp" == ""} {
        return ""
    }
    set p [string trim $origp " \t\n!;'<>?*%$#"]
    if {"$p" == ""} {
        Msg "'$origp' is not a legal filename."
    }
    return $p
}

proc save_query_cmd {{procname ""}} {
    global Tkprfolder Query
    if {$procname == ""} {
        set p ""
        while {"$p" == ""} {
            ###set p [file tail [get_save_file_name Query]]
            set p [get_save_file_name Query]
            if {"$p" == ""} {
                headingMsg "Save cancelled"
                return
            }
	    regexp $Tkprfolder(foldernameregexp) $p match
	    if {$p != $match} {
		Msg "Folder names must be composed only of letters, numbers, underscores and periods."
		return
	    }
            set sfname $Tkprfolder(user_query_dir)/$p
            if {[file exists $sfname]} {
                bell
                if {[tk_dialog .tkprfolder_delete "Confirm_Save" "$p already exists" \
                        "warning" -1 "Overwrite" "Cancel"] != 0} {
                    set p ""
                }
            }
        }
    }

    set number_field [textget Number $Query(stextparent,Number)]
    if {"$number_field" != ""} {
        clear_query_cmd noclearheadingmsg
        regsub -all "," $number_field " " prid_list
        textset Number $prid_list $Query(stextparent,Number)
        if {$procname != ""} {
            query_cmd $prid_list
            return 1
        }
    }
                
    if {$procname == ""} {
        set   sfout [open $sfname w]
        puts $sfout "clear_query_cmd"
        puts $sfout "set Query(user_sort_flds) \{$Query(user_sort_flds)\}"
    } {
        build_query_header $procname
    }

    # for array globals
    
    foreach f {
	State Priority Confidential Category Severity Class Responsible Submitter
    } {
	global $f
        if {$procname == ""} {
            puts $sfout "global $f"
            foreach a [array names $f] {
                if {"[set [set f]($a)]" != ""} {
                    puts $sfout "set [format "%s(%s)" $f $a] [set [set f]($a)]"
                }
            }
        } {
            set l {}
            foreach a [array names $f] {
                lappend l [set [set f]($a)]
            }
            global ${f}_regexp
            set regexp ""
            if {[info exists ${f}_regexp]} {
                set regexp [textget RegExp [set [set f]_regexp]]
            }
            build_regex_query_qualifier -or -exact $f $l $regexp
        }
    }

    # save query for listboxes
    
    if {$procname == ""} {
        save_query_listboxes $sfout clb.cat categories   Category
        save_query_listboxes $sfout slb.sub submitters   Submitter
        save_query_listboxes $sfout rlb.res responsibles Responsible
    }

    # the text field regexp values
    
    foreach f {
	Synopsis Days-idle Originator Text-Fields Release Number Keywords
    } {
        if {$procname == ""} {
            if {[textget $f $Query(stextparent,$f)] != ""} {
                puts $sfout "global  $f"
                puts $sfout "textset $f \"[textget $f $Query(stextparent,$f)]\" \$Query(stextparent,$f)"
            }
        } {
            if {[info exists Query(stextparent,$f)] && "[textget $f $Query(stextparent,$f)]" != ""} {
                switch -exact -- $f Originator {
                    build_regex_query_qualifier -or -glob originator {} [textget $f $Query(stextparent,$f)]
                } Synopsis {
                    build_regex_query_qualifier -or -glob synopsis   {} [textget $f $Query(stextparent,$f)]
                } Days-idle {
                    build_mtime_query_qualifier [textget $f $Query(stextparent,$f)]
                } Text-Fields {
                    build_regex_query_qualifier -or -glob multitext  {} [textget $f $Query(stextparent,$f)]
                } Release {
                    build_regex_query_qualifier -or -glob release    {} [textget $f $Query(stextparent,$f)]
                } Number {
                    # We return above, so this is never reached
		} Keywords {
		    build_regex_query_qualifier -or -glob keywords   {} [textget $f $Query(stextparent,$f)]
                } default {
                    Msg "Illegal query text field '$f'."
                }
            }
        }
    }

    if {$procname == ""} {
        close $sfout
        headingMsg "Query saved as $sfname"
    } {
        build_query_trailer
#####puts "$Query(default__query)"  
    }  
}

proc clear_query_cmd {{headingmsgflag ""}} {
    global lbpath Tkprfolder Query TkGnats

    if {[string compare $headingmsgflag ""] == 0} {
        headingMsg ""
    }

    # for array globals
    foreach f {
	State Priority Confidential Category Severity Class Responsible Submitter
    } {
	global $f
        foreach a [array names $f] {
            set [set f]($a) {}
        }
    }

    # Query listboxes
    category_listbox    .eboxs.clb $Query(category_pat)]
    submitter_listbox   .eboxs.slb $Query(submitter_pat)]
    responsible_listbox .eboxs.rlb $Query(responsible_pat)]
    textset RegExp ""   .eboxs.clb.reg
    textset RegExp ""   .eboxs.slb.reg
    textset RegExp ""   .eboxs.rlb.reg

    # the text field values
    foreach f {
	Synopsis Days-idle Originator Text-Fields Release Number
    } {
        textset $f "" $Query(stextparent,$f)
    }

    if {$TkGnats(ReleaseBased)} {
	textset Keywords "" $Query(stextparent,Keywords)
    }

    # the query listbox
    $lbpath delete 0 end
    disable_listbox_menus
}

proc query_cmd {{prid ""}} {
    global lbpath Query Mappings \
            list_flds_formats list_flds_format list_flds_list list_flds_selected
    array set Class_vals [list sw-bug sw doc-bug doc change-request chg support sup mistaken mis duplicate dup]
    if {"$prid" == ""} {
	# Build a query from the widget specifiers
	if {[save_query_cmd default__query] == 1} {
            return
        } {
            eval $Query(default__query)
        }
    } else {
	# fetch a specific PR
	proc default__query {flds} {return 1}
    }
    
    if {$prid == ""} {
#####puts "Query(query_pr_opts)=$Query(query_pr_opts)"
	set fin [open "|query-pr $Query(query_pr_opts) | $Query(sort_cmd)" r]
    } else {
	set fin [open "|query-pr -i $prid | $Query(sort_cmd)" r]
    }

    if {$Query(curr_prid) >= 0} {
        set Query(curr_prid) [pridfromsummaryline [selln $lbpath]]
    }
    $lbpath delete 0 end; # clear current list
    set c 0
    while {[gets $fin ln] >= 0} {
	incr c
	if {"$ln" == ""} {
	    puts stderr "tkquerypr: warning: line $c empty in query output"
	    puts stderr "Have the gnats administrator check the index file"
	    puts stderr "for bogus entries"
	    continue
	}
        
	#
	# XXX TBD BUG XXX there is a problemo here if the synopsis
	# has a '|' character in it..
	#
	set l [split $ln "|"]
	set llen [llength $l]
	if {$llen != 14} {
	    puts stderr "tkquerypr: warning: line \"$ln\" has $llen fields."
	    puts stderr "It should have 14 fields. Have the gnats "
	    puts stderr "administrator check the index file for bogus entries."
	    puts stderr "(Especially for |'s in the Synopsis fields)"
	    continue
	}
        
        set flds(Number)       [string trimright [lindex $l  0] " "]
        set flds(Category)     [string trimright [lindex $l  1] " "]
        set flds(Synopsis)     [string trimright [lindex $l  2] " "]
        set flds(Confidential) [string trimright [lindex $l  3] " "]
        set flds(Severity)     [string trimright [lindex $l  4] " "]
        set flds(Priority)     [string trimright [lindex $l  5] " "]
        set flds(Responsible)  [string trimright [lindex $l  6] " "]
        set flds(State)        [string trimright [lindex $l  7] " "]
        set flds(Class)        [string trimright [lindex $l  8] " "]
        set flds(Submitter-Id) [string trimright [lindex $l  9] " "]
        set flds(Arrival-Date) [string trimright [lindex $l 10] " "]
        set flds(Originator)   [string trimright [lindex $l 11] " "]
        set flds(Release)      [string trimright [lindex $l 12] " "]
        
	# re-map the numeric fields into text
	foreach f {State Priority Severity Class} {
	    set flds($f) [lindex $Mappings($f) [expr "$flds($f) - 1"]]
	}

        #####   "%5d %-11s %-16s %-5s %-9s %-8s %-12s %s"
        set list_flds_format ""
	case $flds(Category) "_*" {
            continue
	} default {
	    if {[default__query flds]} {
                set ln ""
                for {set i 0} {$i < [llength $list_flds_list]} {incr i 2} {
                    set x [lindex $list_flds_list $i]
                    if {$list_flds_selected($x) != ""} {
                        if {($x == "Originator") || ($x == "Arrival-Date")} {
                            append ln [format $list_flds_formats($x) \
                                    [lindex [split $flds($x) "@ "] 0]]
                        } elseif {[info exists ${x}_vals]} {
                            append ln [format $list_flds_formats($x) [subst $${x}_vals($flds($x))]]
                        } {
                            append ln [format $list_flds_formats($x) $flds($x)]
                        }
                        append list_flds_format $list_flds_formats($x)
                    }
                }
		$lbpath insert end $ln
	    }
	}
    }

    catch {close $fin}
    if {[$lbpath size] == 0 } {
        bell
        $lbpath insert end " "
        $lbpath insert end "...No problem reports found with that search criteria..."
        disable_listbox_menus
    } {
        enable_listbox_menus
        if {$Query(curr_prid) > 0} {
            set lidx [lsearch -regexp [$lbpath get 0 end] "^ *$Query(curr_prid) "]
            if {$lidx < 0} {
                set lidx 0
            }
        } {
            set Query(curr_prid)  0
            set lidx 0
        }
        $lbpath activate $lidx
        $lbpath selection set $lidx
        $lbpath see $lidx
    }
}

proc perform_query_cmd {{query _list_} {prid {}}} {
    global lbpath Query TkGnats list_flds_heading
    . configure -cursor watch

    if {[string compare $Query(done_msg) ""] == 0} {
        set Query(done_msg) Query
    }
    headingMsg "Performing $Query(done_msg)..."

    set_query_sorting_cmd

    case $query {_list_} {
	query_cmd
    } prid {
	query_cmd $prid
    }
    headingMsg "Done $Query(done_msg)"
    set Query(done_msg) ""
    . configure -cursor left_ptr
    return
}

proc perform_print_cmd {{print _list_}} {
    global Print lbpath Query TkGnats list_flds_heading
        
    set Print(fields) $list_flds_heading
    
    set Query(done_msg) "$print print"
    headingMsg "Performing $Query(done_msg)..."
    set done_msg "Done $Query(done_msg)"
    
    if {[print_dialog] != 0} {
        headingMsg "Cancelled $Query(done_msg)"
        set done_msg ""
        return
    }
    
    . configure -cursor watch

    if {![info exists TkGnats(MsMacroSet)]} {
	set TkGnats(MsMacroSet) "-ms"
    }
    
    case $Print(Device) previewer {
	set previewfile /tmp/tkq.ps.$TkGnats(LogName)
        if {[string compare $Print(Format) "troff"] == 0} {
            set fout [open "|cat > $previewfile" w]
        } {
            set fout [open "|groff -t -T$Print(Format) $TkGnats(MsMacroSet) > $previewfile" w]
        }
    } printer {
        if {[string compare $Print(Format) "troff"] == 0} {
            set fout [open "| $Print(PrintSpooler,$Print(Format))" w]
        } {
            set fout [open "|groff -t -T$Print(Format) $TkGnats(MsMacroSet) | $Print(PrintSpooler,$Print(Format))" "w"]
        }
    } file {
        if {[string compare $Print(Format) "troff"] == 0} {
            set fout [open "|cat > $Print(savefile)" w]
        } {
            set fout [open "|groff -t -T$Print(Format) $TkGnats(MsMacroSet) > $Print(savefile)" w]
        }
    }

    set Print(fout) $fout
    
    print_listbox $lbpath $print
   
    catch {close $fout}
    if {[string compare $Print(Device) "previewer"] == 0} {
	exec sh -c \
	 "[format $Print(Previewer,$Print(Format)) $previewfile]\;rm -f $previewfile"  &
	schedule_reap
    }
    
    headingMsg "$done_msg"
    set Query(done_msg) ""
    . configure -cursor left_ptr
    return
}

#
# filter procs
#
proc filter_get_list {dir} {
    if {![file isdirectory $dir]} {
	tkerror "$dir is not a directory"
    } else {
	return [glob -nocomplain -- $dir/*]
    }
}
proc filter_assemble_menuitems {m dir lboxpath} {
##    set flist [filter_get_list $dir]
    set flist [glob -nocomplain -- $dir]
    set n 0
    foreach x $flist {
        incr n
        set cmd [file tail $x]
        regsub -all "_" $cmd " " name
	$m add command -label "$n. $name" -command "filter_run $x $lboxpath"
    }
}

proc XXXfilter_run {filtname lbox} {
    global Print Query TkGnats GNATS_ROOT
    set lboxsize [$lbox size]
##    source $TkGnats(lib)/$filtname
    source /usr/local/lib/tkgnats-2.0/synopsis_summary.tcl
    for {set i 0} {$i<$lboxsize} {incr i} {
	set ln   [$lbox get $i]
	set prid [pridfromsummaryline $ln]
        set fin  [open "|query-pr --full [file tail $prid]" r]
        parsepr $fin flds
        close   $fin
        $filtname $Print(fout) $flds
    }
}

proc filter_run {filtname lbox} {
    global TkGnats GNATS_ROOT
    set lboxsize [$lbox size]
    set filter [open "|$filtname" w]
    for {set i 0} {$i<$lboxsize} {incr i} {
	set ln   [$lbox get $i]
	set prid [pridfromsummaryline $ln]
        set fin  [open "|query-pr --full [file tail $prid]" r]
        parsepr $fin flds
        close   $fin
	puts $filter "$GNATS_ROOT/[ftrim $flds(>Category)]/$prid $ln"
    }
    catch {close $filter}
}

proc set_query_sorting_cmd {} {
    global Query
    set Query(sort_cmd) \
            [build_sort_cmd $Query(sort_flds) $Query(sort_flgs) $Query(user_sort_flds)]
}
proc set_query_sort_fields {} {
    global Query
    sort_Dialog $Query(sort_flds) $Query(sort_flgs) $Query(user_sort_flds) \
            $Query(default_sort_flds) $Query(default_sort_file)
}


proc exit_cmd {} {
    Exit 0
}

#
# ---- Process args
#
proc usage {{exitFlg ""} {str ""}} {
    if {"$str" != ""} {
	puts stderr "tkquerypr: $str"
    }
    puts stderr "tkquerypr usage:\n"
    foreach ln {
	{tkquerypr [-categories 'pattern']}
    } {
	puts stderr "\t$ln"
    }
    if {"$exitFlg" != ""} {
	Exit $exitFlg
    }
}
proc process_args {} {
    global argc argv Query
    if {$argc != 0} {
	if {$argc%2 != 0} {
	    usage 1
	}
	for {set x 0} {$x<$argc} {incr x 2} {
	    set opt [lindex $argv $x]
	    set val [lindex $argv [expr $x+1]]
	    case $opt "-categories" {
		set Query(category_pat) $val
	    } default {
		usage 1 "illegal option pair '$opt $val'"
	    }
	}
    }
}

get_default_sort_criteria

process_args

#
# ---- Build widgets
#

frame   .mframe     -borderwidth 1 -relief raised
pack    .mframe     -side top -fill x
##button  .mframe.l   -bitmap @$TkGnats(lib)/working1.xbm -command query_from_selection
##pack    .mframe.l   -side left
message .mframe.msg -aspect 10000 
pack    .mframe.msg -side left -fill x

menubutton .mframe.help -text "Help" -menu .mframe.help.m -underline 0
menu       .mframe.help.m
.mframe.help.m add command -label "Overview" \
        -command "helpMsg Query_Overview"
.mframe.help.m add separator
.mframe.help.m add command -label "Field Definitions" \
        -command "helpMsg Field_Definitions"
.mframe.help.m add command -label "Regular Expressions" \
        -command "helpMsg Query_Regular_Expressions"
.mframe.help.m add separator
.mframe.help.m add command -label "Check Buttons (Class, etc)" \
        -command "helpMsg Query_Check_Buttons"
.mframe.help.m add command -label "Listbox Selectors (Category, etc)" \
        -command "helpMsg Query_Listbox_Selectors"
.mframe.help.m add command -label "Entry Fields (Synopsis, etc)" \
        -command "helpMsg Query_Entry_Fields"
.mframe.help.m add command -label "Menubar (Query, etc)" \
        -command "helpMsg Query_Menubar"
.mframe.help.m add command -label "Query Results Listbox" \
        -command "helpMsg Query_Results_Listbox"
.mframe.help.m add separator
.mframe.help.m add command -label "About" \
        -command "helpMsg TkGnats_Version"
pack .mframe.help -side right

frame .eflds
radiobar_frame .eflds .eflds.lb
checkbar .eflds.lb class Class {sw-bug doc-bug change-request support mistaken duplicate} All
checkbar .eflds.lb state State {open analyzed feedback closed suspended} All
checkbar .eflds.lb priority Priority {low medium high} All
checkbar .eflds.lb severity Severity {non-critical serious critical} All
checkbar .eflds.lb confidential Confidential {yes no} All

frame .eboxs
frame .eboxs.clb -relief groove -borderwidth 2
set   cbpath [category_listbox    .eboxs.clb $Query(category_pat)]
frame .eboxs.slb -relief groove -borderwidth 2
set   sbpath [submitter_listbox   .eboxs.slb $Query(submitter_pat)]
frame .eboxs.rlb -relief groove -borderwidth 2
set   rbpath [responsible_listbox .eboxs.rlb $Query(responsible_pat)]

pack .eboxs.clb -side left -padx 0
pack .eboxs.slb -side left -padx 4
pack .eboxs.rlb -side left -padx 0
pack .eflds -side top -fill x -anchor w -padx 0
pack .eboxs -side top -fill x -anchor w -pady 4

frame .stext   -relief flat
frame .stext.l -relief flat
frame .stext.r -relief flat
pack  .stext            -side top  -fill x -expand no  -anchor w
pack  .stext.l .stext.r -side left -fill x -expand yes -anchor nw

set Query(stextparent,Number)      .stext.l
set Query(stextparent,Release)     .stext.r
set Query(stextparent,Synopsis)    .stext.l
set Query(stextparent,Originator)  .stext.r
set Query(stextparent,Text-Fields) .stext.l
set Query(stextparent,Days-idle)   .stext.r

if {$TkGnats(ReleaseBased)} {
    set Query(stextparent,Keywords) .stext.l
}

lappend Query(tlist) [singletext $Query(stextparent,Number)      Number      40 "" 13]
lappend Query(tlist) [singletext $Query(stextparent,Release)     Release     40 "" 13]
lappend Query(tlist) [singletext $Query(stextparent,Synopsis)    Synopsis    40 "" 13]
lappend Query(tlist) [singletext $Query(stextparent,Originator)  Originator  40 "" 13]
lappend Query(tlist) [singletext $Query(stextparent,Text-Fields) Text-Fields 40 "" 13]
lappend Query(tlist) [singletext $Query(stextparent,Days-idle)   Days-idle   40 "" 13]

if {$TkGnats(ReleaseBased)} {
    lappend Query(tlist) [singletext $Query(stextparent,Keywords) Keywords   40 "" 13]
}
    
set_text_traversal $Query(tlist)

#
# Menus
#

frame .menu -relief raised -borderwidth 1
pack  .menu -side top -fill x -pady 4

frame .qlb
pack  .qlb -expand true -fill both
set   lbpath [query_listbox .qlb]

#
# Query Menu
#

proc build_query_menu {} {
    global Query Tkprfolder
    if {[winfo exists .menu.query.m]} {
        destroy .menu.query.m
    } {
        menubutton .menu.query -text "Query" -menu .menu.query.m -underline 0
    }
    menu .menu.query.m
    .menu.query.m  configure  -disabledforeground [.menu.query.m cget -foreground]
    .menu.query.m add command -label "Do Query"        -command perform_query_cmd
    .menu.query.m add command -label "Query Selection" -command query_from_selection
    .menu.query.m add command -label "Clear Widgets"   -command clear_query_cmd
    .menu.query.m add command -label "Save Current..." -command folder_save_query_cmd
    .menu.query.m add command -label "Manage Saved..." -command folder_view_query_cmd

    .menu.query.m add separator
    .menu.query.m add command -label "   Query For:" -state disabled
    foreach x "[lsort [glob -nocomplain $Tkprfolder(site_query_dir)/*]]" {
        regsub -all "_" [file tail $x] " " name
        .menu.query.m add command -label " - $name" -command "source $x
        set Query(done_msg) \"query for $name\"
        perform_query_cmd"
    }
    .menu.query.m add separator
    .menu.query.m add command -label "   Saved Queries:" -state disabled
    set n 0
    foreach x "[lsort [glob -nocomplain $Tkprfolder(user_query_dir)/*]]" {
        incr n
        regsub -all "_" [file tail $x] " " name
        .menu.query.m add command -label "$n. $name" -command "source $x
        set Query(done_msg) \"query for $name\"
        perform_query_cmd"
    }
}
build_query_menu

#
# Sort Menu
#

proc build_sort_menu {} {
    global Tkprfolder
    if {[winfo exists .menu.sort.m]} {
        destroy .menu.sort.m
    } {
        menubutton .menu.sort -text "Sort" -menu .menu.sort.m -underline 0
    }
    menu .menu.sort.m
    .menu.sort.m  configure  -disabledforeground [.menu.sort.m cget -foreground]
    .menu.sort.m add command -label "New..."          -command set_query_sort_fields
    .menu.sort.m add command -label "Save Current..." -command folder_save_sort_cmd
    .menu.sort.m add command -label "Manage Saved..." -command folder_view_sort_cmd

    .menu.sort.m add separator
    .menu.sort.m add command -label "   Sort By:" -state disabled
    foreach x "[lsort [glob -nocomplain $Tkprfolder(site_sort_dir)/*]]" {
        regsub -all "_" [file tail $x] " " name
        .menu.sort.m add command -label " - $name" -command "source $x
        set Query(done_msg) \"sort by $name\"
        perform_query_cmd"
    }
    .menu.sort.m add separator
    .menu.sort.m add command -label "   Saved Sorts:" -state disabled
    set n 0
    foreach x "[lsort [glob -nocomplain $Tkprfolder(user_sort_dir)/*]]" {
        incr n
        regsub -all "_" [file tail $x] " " name
        .menu.sort.m add command -label "$n. $name" -command "source $x
        perform_query_cmd"
    }
}
build_sort_menu

#
# Fields Menu
#

menubutton .menu.view -text "Fields" -menu .menu.view.m -underline 0
menu       .menu.view.m
set list_flds_selected(Number) Number
for {set i 2} {$i < [llength $list_flds_list]} {incr i 2} {
    set x [lindex $list_flds_list $i]
    .menu.view.m add checkbutton -label $x -command "set_query_view_fields" \
            -offvalue "" -onvalue $x -variable [format "list_flds_selected(%s)" $x]
}

#
# Print Menu
#

set Print(savefile)    ""
set Print(Device)      printer
set Print(Format)      ps
set Print(Select)      all

foreach format {ascii dvi latin1 ps troff} {
    if {[info exists TkGnats(${format}Previewer)] && \
            [string compare $TkGnats(${format}Previewer) ""] != 0} {
        set Print(Previewer,$format)    $TkGnats(${format}Previewer)
    }
    if {[info exists TkGnats(${format}PrintSpooler)] && \
            [string compare $TkGnats(${format}PrintSpooler) ""] != 0} {
        set Print(PrintSpooler,$format) $TkGnats(${format}PrintSpooler)
    }
}

menubutton .menu.print -text "Print" -menu .menu.print.m -underline 0
menu       .menu.print.m
.menu.print.m  configure  -disabledforeground [.menu.print.m cget -foreground]

#####.menu.print.m add command -label "  Report Formats:" -state disabled
.menu.print.m add command -label "Summary..." \
        -command "perform_print_cmd Summary"
.menu.print.m add command -label "Medium..." \
        -command "perform_print_cmd Medium"
.menu.print.m add command -label "Full..." \
        -command "perform_print_cmd Full"
.menu.print.m add command -label "Raw Data..." \
        -command "perform_print_cmd Raw_Data"

.menu.print.m add separator
 
# Add any site print commands
set n 0
foreach x "[lsort [glob -nocomplain $Tkprfolder(site_print_dir)/*]]" {
    incr n
    set  cmd [file tail $x]
    regsub -all "_" $cmd " " name
    if {[string compare [file extension $cmd] "_Filter"] == 0} {
        filter_assemble_menuitems .menu.print.m $x $lbpath
    } {
        .menu.print.m add command -label "$n. $name..." -command "source $x
        perform_print_cmd $cmd"
    }
}

#
# Actions Menu
#

menubutton .menu.sel -text "Actions" -menu .menu.sel.m -underline 0
menu       .menu.sel.m

.menu.sel.m add command -label "Edit..."           -command "selection_Edit_cmd $lbpath"
if {! $TkGnats(edit_authorized)} {
    .menu.sel.m entryconfigure "Edit..." -state disabled
}
.menu.sel.m add command -label "View..."           -command "selection_View_Formatted_cmd $lbpath"
.menu.sel.m add command -label "View Raw Data..."  -command "selection_View_Raw_cmd      $lbpath"

.menu.sel.m add separator

if {$TkGnats(delete_authorized)} {
    .menu.sel.m add command -label "Delete PERMANENTLY" -command "selection_Delete_cmd $lbpath"
    .menu.sel.m add separator
}

.menu.sel.m add command -label "Remove From List"  -command "selection_Remove_cmd $lbpath"

.menu.sel.m add separator

.menu.sel.m add command -label "Send Email..."     -command "selection_Email_cmd  $lbpath"

button .menu.doquery -text "Do Query" -command perform_query_cmd
button .menu.clear   -text "Clear"    -command clear_query_cmd
button .menu.exit    -text "Exit"     -command exit_cmd

pack   .menu.doquery .menu.clear -side left

foreach x {
    query sort view print sel
} {
    pack .menu.$x -side left
}

disable_listbox_menus

pack .menu.exit -side right

wm title      . "TkGnats - Query Problem Reports"
wm iconbitmap . @$TkGnats(lib)/tkquerypr.xbm
wm iconname   . "$TkGnats(LogName)'s tkquerypr"
