blob: 6b03d74d1d17a5bf66efe440e89d2e2614acfacb (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
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]
}
}
}
}
}
|
