diff options
Diffstat (limited to 'ds9/library/fp.tcl')
-rw-r--r-- | ds9/library/fp.tcl | 42 |
1 files changed, 30 insertions, 12 deletions
diff --git a/ds9/library/fp.tcl b/ds9/library/fp.tcl index 675d05d..e750ae1 100644 --- a/ds9/library/fp.tcl +++ b/ds9/library/fp.tcl @@ -116,10 +116,10 @@ proc FPTable {varname} { } } - # filter regions + # concat regions set var(tbldb) ${varname}tbldb global $var(tbldb) - if {![eval $var(proc,flt) $varname]} { + if {![eval $var(proc,reg) $varname $var(catdb) $var(tbldb)]} { Error [msgcat::mc {Internal Parse Error}] if {[info exists $var(tbldb)]} { unset $var(tbldb) @@ -127,6 +127,20 @@ proc FPTable {varname} { set var(tbldb) $var(catdb) } + if {$var(filter) == {} && $var(sort) == {}} { + ; + } else { + set var(tbldb) ${varname}tbldb + global $var(tbldb) + if {![TBLFltSort $varname $var(catdb) $var(tbldb)]} { + Error "[msgcat::mc {Unable to evaluate filter}] $var(filter)" + if {[info exists $var(tbldb)]} { + unset $var(tbldb) + } + set var(tbldb) $var(catdb) + } + } + global $var(tbldb) $var(tbl) configure -variable $var(tbldb) $var(found) configure -textvariable ${var(tbldb)}(Nrows) @@ -157,14 +171,15 @@ proc FPTable {varname} { FPGenerate $varname } -proc FPFltCXC {varname} { +proc FPRegCXC {varname src dest} { upvar #0 $varname var global $varname - global $var(catdb) - global $var(tbldb) - upvar #0 $var(catdb) catsrc - upvar #0 $var(tbldb) catdest + upvar #0 $src catsrc + global $src + + upvar #0 $dest catdest + global $dest # create header set catdest(Header) $catsrc(Header) @@ -245,14 +260,15 @@ proc FPFltCXC {varname} { return 1 } -proc FPFltHLA {varname} { +proc FPRegHLA {varname src dest} { upvar #0 $varname var global $varname - global $var(catdb) - global $var(tbldb) - upvar #0 $var(catdb) catsrc - upvar #0 $var(tbldb) catdest + upvar #0 $src catsrc + global $src + + upvar #0 $dest catdest + global $dest # create header set catdest(Header) $catsrc(Header) @@ -426,6 +442,8 @@ proc FPOff {varname} { } } + set var(filter) {} + set var(sort) {} set var(blink) 0 FPDialogUpdate $varname |