summaryrefslogtreecommitdiffstats
path: root/ds9/library/group.tcl
blob: 95bb524d5e296018140baac1e7fd3432dfe5057c (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
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
#  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

proc GroupDef {} {
    global igroup
    global dgroup

    set igroup(top) .grp
    set igroup(mb) .grpmb

    set dgroup(list) {}
}

proc GroupCreate {} {
    global current

    if {$current(frame) != {}} {
	set name [$current(frame) get marker tag default name]
	if {[EntryDialog [msgcat::mc {New Group}] [msgcat::mc {Enter Group Name}] 30 name]} {
	    $current(frame) marker tag "\{$name\}"
	    UpdateGroupDialog
	}
    }
}

proc GroupCreateSilent {} {
    global current

    if {$current(frame) != {}} {
	set name [$current(frame) get marker tag default name]
	$current(frame) marker tag "\{$name\}"
	UpdateGroupDialog
    }
}

proc GroupDialog {} {
    global ds9
    global igroup
    global dgroup

    # see if we already have a window visible
    if {[winfo exists $igroup(top)]} {
	raise $igroup(top)
	return
    }

    # create the window
    set w $igroup(top)
    set mb $igroup(mb)

    Toplevel $w $mb 6 [msgcat::mc {Groups}] GroupDestroyDialog

    $mb add cascade -label [msgcat::mc {File}] -menu $mb.file
    menu $mb.file
    $mb.file add command -label [msgcat::mc {Update Group}] \
	-command GroupUpdateDialog
    $mb.file add separator
    $mb.file add command -label [msgcat::mc {New Group}] \
	-command GroupCreate
    $mb.file add command -label [msgcat::mc {Edit Group Name}] \
	-command GroupEditDialog
    $mb.file add separator
    $mb.file add command -label [msgcat::mc {Delete Group}] \
	-command GroupDeleteDialog
    $mb.file add command -label [msgcat::mc {Delete All Groups}] \
	-command GroupDeleteAllDialog
    $mb.file add separator
    $mb.file add command -label [msgcat::mc {Close}] \
	-command GroupDestroyDialog

    # List
    set f [ttk::frame $w.param]

    ttk::scrollbar $f.scroll -command [list $f.box yview] -orient vertical
    set dgroup(list) [listbox $f.box \
			  -yscroll [list $f.scroll set] \
			  -setgrid true \
			  -selectmode multiple \
			  ]
    grid $f.box $f.scroll -sticky news
    grid rowconfigure $f 0 -weight 1
    grid columnconfigure $f 0 -weight 1

    bind $dgroup(list) <<ListboxSelect>> GroupButtonDialog

    # Buttons
    set f [ttk::frame $w.buttons]
    ttk::button $f.update -text [msgcat::mc {Update}] \
	-command GroupUpdateDialog
    ttk::button $f.close -text [msgcat::mc {Close}] \
	-command GroupDestroyDialog
    pack $f.update $f.close -side left -expand true -padx 2 -pady 4

    # Fini
    ttk::separator $w.sep -orient horizontal
    pack $w.buttons $w.sep -side bottom -fill x
    pack $w.param -fill both -expand true

    UpdateGroupDialog
}

proc GroupButtonDialog {} {
    global dgroup
    global current

    if {$current(frame) != {}} {
	$current(frame) marker unselect all
	set rr [$dgroup(list) curselection]
	foreach ii $rr {
	    if {[string length $ii] != 0} {
		$current(frame) marker "\{[$dgroup(list) get $ii]\}" select
	    }
	}
    }
}

proc GroupDestroyDialog {} {
    global igroup

    if {[winfo exists $igroup(top)]} {
	destroy $igroup(top)
	destroy $igroup(mb)
    }
}

proc GroupUpdateDialog {} {
    global dgroup
    global current

    if {$current(frame) != {}} {
	set ll [$dgroup(list) curselection]
	if {[string length $ll] != 0} {
	    $current(frame) marker tag update "\{[$dgroup(list) get $ll]\}"
	}
    }
}

proc GroupEditDialog {} {
    global dgroup
    global current
    
    if {$current(frame) != {}} {
	set i [$dgroup(list) curselection]
	if {[string length $i] != 0} {
	    set which [$dgroup(list) get $i]
	    if {[EntryDialog [msgcat::mc {Group Name}] [msgcat::mc {Enter Group Name}] 40 which]} {
		$current(frame) marker tag edit "\{[$dgroup(list) get $i]\}" "\{$which\}"
		UpdateGroupDialog
	    }
	}
    }
}

proc GroupDeleteDialog {} {
    global dgroup
    global current

    if {$current(frame) != {}} {
	set i [$dgroup(list) curselection]
	if {[string length $i] != 0} {
	    set which [$dgroup(list) get $i]
	    $current(frame) marker tag delete "\{$which\}"
	    UpdateGroupDialog
	}
    }
}

proc GroupDeleteAllDialog {} {
    global current
    global pds9

    if {$current(frame) != {}} {
	if {$pds9(confirm)} {
	    if {[tk_messageBox -type okcancel -icon question -message \
		     [msgcat::mc {Delete All Groups?}]] != {ok}} {
		return
	    }
	}
	$current(frame) marker tag delete all
	UpdateGroupDialog
    }
}

proc UpdateGroupDialog {} {
    global igroup
    global dgroup
    global current

    global debug
    if {$debug(tcl,update)} {
	puts stderr "UpdateGroupDialog"
    }

    if {[winfo exists $igroup(top)]} {
	# clear the list
	$dgroup(list) delete 0 end

	if {$current(frame) != {}} {
	    set grps [lsort [$current(frame) get marker tag all]]
	    foreach f $grps {
		$dgroup(list) insert end $f
	    }
	}
    }
}