diff options
Diffstat (limited to 'ds9/library/catopt.tcl')
-rw-r--r-- | ds9/library/catopt.tcl | 57 |
1 files changed, 57 insertions, 0 deletions
diff --git a/ds9/library/catopt.tcl b/ds9/library/catopt.tcl new file mode 100644 index 0000000..6b03d74 --- /dev/null +++ b/ds9/library/catopt.tcl @@ -0,0 +1,57 @@ +# Copyright (C) 1999-2016 +# Smithsonian Astrophysical Observatory, Cambridge, MA, USA +# For conditions of distribution and use, see copyright notice in "copyright" + +package provide DS9 1.0 + +# sample CATKeyCB +# Allow the user to define callbacks to be called when +# the user presses a key with selected regions while in edit mode. + +if {0} { +# add to CATReg +# callback=key CATKeyCB {${varname}.\${ii}.a} + +proc CATKeyCB {tag id} { + global icat + + global debug + if {$debug(tcl,cat)} { + puts stderr "CATKeyCB $tag $id" + } + + set t [split $tag .] + set varname [lindex $t 0] + set row [lindex $t 1] + set key [lindex $t 2] + + upvar #0 $varname var + global $varname + global $var(tbldb) + + if {![info exists ${varname}(top)]} { + return + } + + if {$icat(key) == $key} { + switch -- $key { + a { + puts stderr "Key: $key $row" + return + + # column name 'TooManySrcs' + set tcol [starbase_colnum $var(tbldb) {TooManySrcs}] + + # toggle between '0' and '1' + set tt [starbase_get $var(tbldb) $row $tcol] + if {$tt == {1}} { + starbase_set $var(tbldb) $row $tcol {0} + } else { + starbase_set $var(tbldb) $row $tcol {1} + } + lappend icat(key,update) [list $varname $row] + } + } + } +} +} |