diff options
Diffstat (limited to 'ds9/library/group.tcl')
-rw-r--r-- | ds9/library/group.tcl | 208 |
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 + } + } + } +} |