add footprint filter / sort support

5 files changed, 57 insertions, 45 deletions

diff --git a/ds9/library/cat.tcl b/ds9/library/cat.tcl
index 207e9a8..f87e427 100644
--- a/ds9/library/cat.tcl
+++ b/ds9/library/cat.tcl
@@ -155,7 +155,7 @@ proc CATLoadDone {varname} {
 	puts stderr "CATLoadDone $varname"
     }
 
-    CATSortMenu $varname
+    TBLSortMenu $varname
     CATConfigCols $varname
     CATColsMenu $varname
     CATTable $varname
@@ -412,7 +412,7 @@ proc CATOff {varname} {
 	}
     }
 
-    CATSortMenu $varname
+    TBLSortMenu $varname
     CATColsMenu $varname
     set var(filter) {}
     set var(sort) {}
@@ -534,41 +534,6 @@ proc CATServerMenu {varname} {
     }
 }
 
-proc CATSortMenu {varname} {
-    upvar #0 $varname var
-    global $varname
-    global $var(catdb)
-
-    global ds9
-
-    set m $var(sortmenu).menu
-    catch {destroy $m}
-
-    menu $m -tearoff 0
-    $m add command -label {} -command "CATSortCmd $varname {}"
-    if {[TBLValidDB $var(catdb)]} {
-	set cnt -1
-	foreach col [starbase_columns $var(catdb)] {
-	    $m add command -label $col -command "CATSortCmd $varname \{$col\}"
-
-	    # wrap if needed
-	    incr cnt
-	    if {$cnt>=$ds9(menu,size,wrap)} {
-		set cnt 0
-		$m entryconfig $col -columnbreak 1
-	    }
-	}
-    }
-}
-
-proc CATSortCmd {varname val} {
-    upvar #0 $varname var
-    global $varname
-
-    set ${varname}(sort) $val
-    CATTable $varname
-}
-
 # backward backup compatibility version 6.1
 proc CATRADECMenu {varname} {
     CATColsMenu $varname
diff --git a/ds9/library/catdialog.tcl b/ds9/library/catdialog.tcl
index 6edbf00..4c3ce58 100644
--- a/ds9/library/catdialog.tcl
+++ b/ds9/library/catdialog.tcl
@@ -49,6 +49,7 @@ proc CATDialog {varname format catalog title action} {
     set var(proc,process) CATProcess
     set var(proc,load) CATLoad
     set var(proc,error) ARError
+    set var(proc,table) CATTable
 
     # CAT variables
     lappend icat(cats) $varname
@@ -482,7 +483,7 @@ proc CATDialog {varname format catalog title action} {
     bind $w <<Close>> [list CATDestroy $varname]
 
     # needs to go after sort menu button is defined
-    CATSortMenu $varname
+    TBLSortMenu $varname
     CATColsMenu $varname
     CATColsUpdate $varname
     switch $var(format) {
diff --git a/ds9/library/fp.tcl b/ds9/library/fp.tcl
index e750ae1..219bc2d 100644
--- a/ds9/library/fp.tcl
+++ b/ds9/library/fp.tcl
@@ -80,6 +80,7 @@ proc FPProcess {varname} {
     VOTParse $var(catdb) $var(token)
     ARDone $varname
 
+    TBLSortMenu $varname
     FPTable $varname
     FPDialogUpdate $varname
 }
@@ -130,15 +131,15 @@ proc FPTable {varname} {
     if {$var(filter) == {} && $var(sort) == {}} {
 	;
     } else {
-	set var(tbldb) ${varname}tbldb
-	global $var(tbldb)
-	if {![TBLFltSort $varname $var(catdb) $var(tbldb)]} {
+	set var(tmpdb) ${varname}tmpdb
+	global $var(tmpdb)
+	if {![TBLFltSort $varname $var(tbldb) $var(tmpdb)]} {
 	    Error "[msgcat::mc {Unable to evaluate filter}] $var(filter)"
-	    if {[info exists $var(tbldb)]} {
-		unset $var(tbldb)
-	    }
-	    set var(tbldb) $var(catdb)
+	} else {
+	    unset $var(tbldb)
+	    array set $var(tbldb) [array get $var(tmpdb)]
 	}
+	unset $var(tmpdb)
     }
 
     global $var(tbldb)
@@ -442,6 +443,7 @@ proc FPOff {varname} {
 	}
     }
 
+    TBLSortMenu $varname
     set var(filter) {}
     set var(sort) {}
     set var(blink) 0
diff --git a/ds9/library/fpdialog.tcl b/ds9/library/fpdialog.tcl
index b8c9a0d..5878f44 100644
--- a/ds9/library/fpdialog.tcl
+++ b/ds9/library/fpdialog.tcl
@@ -42,6 +42,7 @@ proc FPDialog {varname title url instr format action} {
     set var(proc,process) FPProcess
     set var(proc,load) FPLoad
     set var(proc,error) ARError
+    set var(proc,table) FPTable
 
     # format
     switch $format {
@@ -301,6 +302,12 @@ proc FPDialog {varname title url instr format action} {
     pack $w.obj $w.instr $w.param -side top -fill x
     pack $w.tbl -side top -fill both -expand true
 
+    bind $w <<Print>> PSPrint
+    bind $w <<Close>> [list FPDestroy $varname]
+
+    # needs to go after sort menu button is defined
+    TBLSortMenu $varname
+
     ARCoord $varname
     FPUpdate $varname
     FPDialogUpdate $varname
diff --git a/ds9/library/table.tcl b/ds9/library/table.tcl
index 911419e..7e74158 100644
--- a/ds9/library/table.tcl
+++ b/ds9/library/table.tcl
@@ -353,6 +353,43 @@ proc TBLSaveFn {varname fn writer} {
     ARDone $varname
 }
 
+# Sort
+
+proc TBLSortMenu {varname} {
+    upvar #0 $varname var
+    global $varname
+    global $var(catdb)
+
+    global ds9
+
+    set m $var(sortmenu).menu
+    catch {destroy $m}
+
+    menu $m -tearoff 0
+    $m add command -label {} -command "TBLSortCmd $varname {}"
+    if {[TBLValidDB $var(catdb)]} {
+	set cnt -1
+	foreach col [starbase_columns $var(catdb)] {
+	    $m add command -label $col -command "TBLSortCmd $varname \{$col\}"
+
+	    # wrap if needed
+	    incr cnt
+	    if {$cnt>=$ds9(menu,size,wrap)} {
+		set cnt 0
+		$m entryconfig $col -columnbreak 1
+	    }
+	}
+    }
+}
+
+proc TBLSortCmd {varname val} {
+    upvar #0 $varname var
+    global $varname
+
+    set ${varname}(sort) $val
+    $var(proc,table) $varname
+}
+
 # Edit Dialog
 
 proc TBLEditDialog {varname which db} {