Initial commit

1 files changed, 208 insertions, 0 deletions

diff --git a/ds9/library/group.tcl b/ds9/library/group.tcl
new file mode 100644
index 0000000..95bb524
--- /dev/null
+++ b/ds9/library/group.tcl
@@ -0,0 +1,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
+	    }
+	}
+    }
+}