From: <ro...@us...> - 2011-12-02 15:02:48
|
Revision: 1906 http://nsclspectcl.svn.sourceforge.net/nsclspectcl/?rev=1906&view=rev Author: ron-fox Date: 2011-12-02 15:02:37 +0000 (Fri, 02 Dec 2011) Log Message: ----------- Get the treeParametersContainer to work. Modified Paths: -------------- trunk/SpecTcl/treegui/treeParameterWidget.tcl trunk/SpecTcl/treegui/treemenuWidget.tcl Added Paths: ----------- trunk/SpecTcl/treegui/treeParametersContainer.tcl Modified: trunk/SpecTcl/treegui/treeParameterWidget.tcl =================================================================== --- trunk/SpecTcl/treegui/treeParameterWidget.tcl 2011-12-01 20:54:51 UTC (rev 1905) +++ trunk/SpecTcl/treegui/treeParameterWidget.tcl 2011-12-02 15:02:37 UTC (rev 1906) @@ -17,6 +17,8 @@ package require Tk package require snit +package provide treeParameterEditor 1.0 + ## # Provide a snit megawidget that allows for the display of a single # tree parameter. @@ -41,6 +43,8 @@ # snit::widget treeParameterEditor { + hulltype ttk::frame + option -name option -low option -high @@ -48,6 +52,7 @@ option -loadcmd [list] option -setcmd [list] option -changecmd [list] + option -title false; # If true titles are put above the text entries. ## @@ -60,12 +65,23 @@ # Build the widgets: + set editorRow 0 + if {$options(-title)} { + ttk::label $win.n -text Name -borderwidth 3 + ttk::label $win.l -text Low -borderwidth 3 + ttk::label $win.h -text High -borderwidth 3 + ttk::label $win.u -text Units -borderwidth 3 + + grid $win.n $win.l $win.h $win.u + set editorRow 1 + } + # First the labels: foreach label [list .name .low .high .unit] optionname [list -name -low -high -units] \ width [list 32 5 5 10] { ::ttk::label $win$label -textvariable ${selfns}::options($optionname) -relief sunken \ - -width $width -borderwidth 3 -anchor w + -width $width -borderwidth 1 -anchor w } # then the buttons: @@ -80,8 +96,10 @@ # Now grid them from left to right: set col 0 + + foreach widget [list .name .low .high .unit .load .set .changespectra] { - grid $win$widget -row 0 -column $col + grid $win$widget -row $editorRow -column $col -sticky ns incr col } } Added: trunk/SpecTcl/treegui/treeParametersContainer.tcl =================================================================== --- trunk/SpecTcl/treegui/treeParametersContainer.tcl (rev 0) +++ trunk/SpecTcl/treegui/treeParametersContainer.tcl 2011-12-02 15:02:37 UTC (rev 1906) @@ -0,0 +1,157 @@ +# This software is Copyright by the Board of Trustees of Michigan +# State University (c) Copyright 2009. +# +# You may use this software under the terms of the GNU public license +# (GPL). The terms of this license are described at: +# +# http://www.gnu.org/licenses/gpl.txt +# +# Author: +# Ron Fox +# NSCL +# Michigan State University +# East Lansing, MI 48824-1321 + +package require Tk +package require snit +package require treemenuWidget +package require treeParameterEditor + +package provide treeParametersContainer 1.0 + +## +# Provide a snit megawidget that can contain a set of treeParameterEditor widgets. +# Editors can be selected via radio buttons on the left of the megawidget. +# The visual on the editor is as follows: +# +# +--------------------------------------------------------------------------+ +# | Parameter<mb> Name Low High Unit [] Array | +# +--------------------------------------------------------------------------+ +# | () | Editor widget 1 | +# +--------------------------------------------------------------------------+ +# | ... | +# +# +--------------------------------------------------------------------------+ +# | () | Editor widget n | +# +--------------------------------------------------------------------------+ +# +# Note that parameter editor widget lines are numbered from 1. +# Note that Parmater<mb> is a menu button with a hierchical menu below it.. +# +# OPTIONS +# -number - Number of parametr editors to provide. (static) default is 20. +# -current - Currently selected parameter editor [1..n] (dynamcic) starts 1 +# -parameters - List of parameters to put in the menubutton hierarchy (dynamic) +# -choosecmd - Command script to run when a parameter is chosen. +# -loadcmd - Command script to run when a load button is clicked. +# -set - Command script to run when a set button is clicked. +# -change - Command script to run when a Change Spectra button is clicked. +# -array - Boolean that indicates/changes the array checkbutton. +# +# METHODS +# get ?n? - Returns the contents of the editor widget n or if omitted +# the currently selected one. This is returned as: +# [list name low high units] +# load n name low high units +# - Loads the contents of selection n if n is 'current' the selected editor is loaded. +# +# ACTION SCRIPT SUBSITUTIONS: +# %W - provides the widget that invoked the action. This is the menu hierarhcy for +# -choosecmd and the specific editor widget for load/set/change scripts. +# %F - provides our widget name +# %L - only for -choosecmd provides the terminal label. +# %N - only for -choosecmd provides the path to the terminal label selected. +# +snit::widget treeParametersContainer { + hulltype ttk::frame + option -number -default 20 + option -current -default 1 + option -parameters -default [list] -configuremethod updateParameterMenu + option -chooscmd -default [list] + option -loadcmd -default [list] + option -set -default [list] + option -change -default [list] + option -array -default false + + variable menuButton; # The button that is attached to the hierarchy menu. + + ## + # Construct the widget: + # @args - a list of name value options pairs. + constructor args { + + # Create the widgets along the to of the container. These are + # the menubutton, the titles and the array check box. + # We can grid those right away. + + set menuButton [ttk::menubutton $win.menu -text Parameter -menu $win.menu.pulldown] + grid $menuButton -row 0 -column 0 + + $self configurelist $args; # Build the menu hierarchy. + + # Now build the radiobutton column and the column of editors. + # the radio button lives in column 0 while the editors span columns 1 -5 inclusive. + + for {set i 1} {$i <= $options(-number)} {incr i} { + set title false + set rowspan 1 + set editorRow $i + if {$i == 1} { + set title true + set rowspan 2 + incr editorRow -1 + } + ttk::frame $win.b$i -relief ridge -borderwidth 1 + ttk::radiobutton $win.b$i.b$i -variable ${selfns}::option(-current) \ + -value $i + pack $win.b$i.b$i + + treeParameterEditor $win.e$i -title $title + grid $win.b$i -row $i -column 0 -sticky ew -pady 0 + grid $win.e$i -row $editorRow -column 1 -rowspan $rowspan -sticky ewns -pady 0 + } + + # This next bit is rather dirty. We want to insert the array check button + # in the right most column of the top editor ($win.e1). This + # ensures it won't hang out over the end of the editors + + ttk::frame $win.e1.arrayframe -relief ridge -borderwidth 2 + ttk::checkbutton $win.e1.arrayframe.array -text Array \ + -offvalue false -onvalue true -variable ${selfns}::options(-array) + pack $win.e1.arrayframe.array + grid $win.e1.arrayframe -row 0 -column 6 -sticky e + + + # If not supplied we need to build by hand: + + if {$options(-parameters) eq ""} { + $self updateParameterMenu -parameters [list] + } + + } + + # configuration methods: + + + ## + # Configuration method for the -parameters option + # kill off the existing hierarchical menu and build a new one from the set of parameters + # we have. + # @param option - the name of the option being configured (-parameters unless we change that). + # @param value - New value for that option, a list of the parameters to put in the menu hierarchy. + # + method updateParameterMenu {option value} { + set options($option) $value + + destroy $menuButton.pulldown + + treeMenu $menuButton.pulldown -items $value -splitchar . -command [mymethod ParameterChosen %W %L %N] + + } + + # Private methods + + method ParameterChosen {widget label path} {} + + +} \ No newline at end of file Modified: trunk/SpecTcl/treegui/treemenuWidget.tcl =================================================================== --- trunk/SpecTcl/treegui/treemenuWidget.tcl 2011-12-01 20:54:51 UTC (rev 1905) +++ trunk/SpecTcl/treegui/treemenuWidget.tcl 2011-12-02 15:02:37 UTC (rev 1906) @@ -16,6 +16,8 @@ package require Tk package require snit +package provide treemenuWidget 1.0 + ## # Provide a snit megawidget that can represent a menu of a tree of names. # The hull of this is the top level menu. This allows the menu to be @@ -143,7 +145,7 @@ lappend cascade $path } } - # If cascade is ot empty, create the submenu and add a cascade for it: + # If cascade is not empty, create the submenu and add a cascade for it: if {[llength $cascade] > 0} { set submenuName $widget.c$submenu @@ -158,7 +160,7 @@ if {$options(-pullright) } { bind $widget <Motion> [list $widget postcascade @%y] } - } + } } } This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ro...@us...> - 2011-12-02 22:16:14
|
Revision: 1910 http://nsclspectcl.svn.sourceforge.net/nsclspectcl/?rev=1910&view=rev Author: ron-fox Date: 2011-12-02 22:16:08 +0000 (Fri, 02 Dec 2011) Log Message: ----------- Correct mis-spellings in option names. Modified Paths: -------------- trunk/SpecTcl/treegui/treeParametersContainer.tcl Added Paths: ----------- trunk/SpecTcl/treegui/parametersTabActions.tcl Added: trunk/SpecTcl/treegui/parametersTabActions.tcl =================================================================== --- trunk/SpecTcl/treegui/parametersTabActions.tcl (rev 0) +++ trunk/SpecTcl/treegui/parametersTabActions.tcl 2011-12-02 22:16:08 UTC (rev 1910) @@ -0,0 +1,243 @@ +# This software is Copyright by the Board of Trustees of Michigan +# State University (c) Copyright 2009. +# +# You may use this software under the terms of the GNU public license +# (GPL). The terms of this license are described at: +# +# http://www.gnu.org/licenses/gpl.txt +# +# Author: +# Ron Fox +# NSCL +# Michigan State University +# East Lansing, MI 48824-1321 + +package require Tk +package require Itcl +package require treeParametersContainer + +package provide parametersTabActions 1.0 + +## +# Provides an itcl class that encapsulates the behavior of the treeParemters container. +# Construction of this class will construct the widget but not make it visible (that's +# for the client to do). +# +# OPTIONS: +# -lines - Number of lines of parameter editors. +# -widget - Name of widget. +# PUBLIC METHODS: +# update - Update the parameter menu list. +# load - Load the editor from a description of its contents. +# + +::itcl::class parametersTabActions { + public variable widget "" + public variable lines 20 + + #------------------------------------------------------------------------------- + # Private Methods: + # + + ## + # Get a list of the tree parameter names: + # + private method parameterList {} { + set treeParameters [treeparameter -list] + set result [list] + + foreach param $treeParameters { + lappend result [lindex $param 0] + } + + return $result + } + + ## + # Load a specific parameter slot with data: + # @param slot - the slot to load. + # @param paath - The tree parameter path. + # + private method loadSlot {slot path} { + + set paramInfo [treeparameter -list $path] + + # For now if there are duplicates, just take the first + + if {[llength $paramInfo] > 0} { + set paramInfo [lindex $paramInfo 0] + $widget load $slot [lindex $paramInfo 0] \ + [lindex $paramInfo 2] \ + [lindex $paramInfo 3] \ + [lindex $paramInfo 5] + } + } + + ## + # Method to prompt for spectrum changes: + # @param spectra list of spectra to prompt for. + # @return bool + # @retval true if change is approved false if not. + # @note false is the default so that we can't accidently kill stuff as easily. + # + private method promptChangeOk spectra { + set spectra [join $spectra {, }] + set message "The following spectra wil be erased and replaced: \n$spectra\n" + append message "Do you wish to continue?" + + set answer [tk_messageBox -type yesno -default no \ + -icon warning -message $message -parent $widget -title {Confirm Change}] + + return [expr $answer eq "no"] + + } + + + ## + # list the spectra that depend on a parameter. + # @param parameter - The parameter to check on. + # @return list + # @retval possibly empty list of dependent spectra. + # + private method listDependentSpectra {parameter} { + set result [list] + foreach spectrum [spectrum -list] { + set paramLists [lindex $spectrum 3] + foreach paramList $paramLists { + if {[lsearch -exact $paramList $parameter] != -1} { + lappend result [lindex $spectrum 1] + break + } + } + } + return $result + } + + #------------------------------------------------------------------------------- + # Public interface: + # + + ## + # Construct the object + # @param args - a list of the option/values to use in construction time. + # + constructor {args} { + eval configure $args; # Set the widget name. + if {$widget eq ""} { + error "The -widget option is mandatory for parametersTabActions" + } + + treeParametersContainer $widget -number $lines -parameters [parameterList] \ + -choosecmd [list $this loadCurrentEditor %N] \ + -loadcmd [list $this reloadEditor %S] \ + -set [list $this setParameter %S] \ + -change [list $this changeSpectra %S] + + } + + + + #---------------------------------------------------------------------------- + # Internal callbacks. + # NOTE: itcl requires these to be public but they are not part of the class + # interface. + + ## + # Load the currently selected editor with a specific tree parameter + # selected from the parameter pull right menu: + # + # @param path - the name of the parameter to load into the editor. + # + # @note - if the tree parameter does not exist, this is a no-op for now. + # + public method loadCurrentEditor path { + + loadSlot [$widget cget -current] $path + + } + + ## + # Handle the load button + # @param slot - the slot whose load button was clicked. + # + # + public method reloadEditor {slot} { + set contents [$widget get $slot] + set path [lindex $contents 0] + + loadSlot $slot $path + + } + + ## + # Handle the Set button. + # + # @param slot - the slot to modify. + # + public method setParameter {slot} { + set contents [$widget get $slot] + set path [lindex $contents 0] + + # If there is no tree parameter by this name, we don't need + # to do anything: + + set currentInfo [treeparameter -list $path] + if {[llength $currentInfo] > 0} { + set currentInfo [lindex $currentInfo 0] + + set low [lindex $contents 1] + set hi [lindex $contents 2] + set units [lindex $contents 3] + set bins [lindex $currentInfo 1] + + # Compute the increment _sigh_ about overdtermination and + # goddamned tree parameters. + + set inc [expr {(1.0*$hi - $low)/$bins}] + + treeparameter -set $path $bins $low $hi $inc $units + + } + } + + ## + # Handles the change button: + # - figures out which spectra depend on the parameter + # - Prompts the user for go/nogo. + # - On go, iterates through the spectra changing the appropriate axis + # limits/bins to matchthe tree parameter axis/bins. + # + # @param slot - The slot whose change button was clicked. + # + public method changeSpectra {slot} { + set contents [$widget get $slot] + set path [lindex $contents 0] + + set currentInfo [treeparameter -list $path] + + # The spectrum is set from the current tree parameter values: + + if {[llength $currentInfo] > 0} { + set currentInfo [lindex $currentInfo 0] + set bins [lindex $currentInfo 1] + set low [lindex $currentInfo 2] + set hi [lindex $currentInfo 3] + + set spectra [listDependentSpectra $path] + + # Get confirmation: + + if {[llength $spectra] > 0} { + if {[promptChangeOk $spectra]} { + return + modifySpectra $spectra $path $bins $low $hi + } + } else { + return + notifyNoMatches + } + } + + } +} + Modified: trunk/SpecTcl/treegui/treeParametersContainer.tcl =================================================================== --- trunk/SpecTcl/treegui/treeParametersContainer.tcl 2011-12-02 22:15:24 UTC (rev 1909) +++ trunk/SpecTcl/treegui/treeParametersContainer.tcl 2011-12-02 22:16:08 UTC (rev 1910) @@ -70,7 +70,7 @@ option -number -default 20 option -current -default 1 option -parameters -default [list] -configuremethod updateParameterMenu - option -chooscmd -default [list] + option -choosecmd -default [list] option -loadcmd -default [list] option -set -default [list] option -change -default [list] @@ -227,7 +227,7 @@ # @param path - Full path to menu label. # method ParameterChosen {widget label path} { - set script $options(-chooscmd) + set script $options(-choosecmd) # Only dispatch if, in fact, there is a nonempty script This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ro...@us...> - 2011-12-06 15:10:48
|
Revision: 1915 http://nsclspectcl.svn.sourceforge.net/nsclspectcl/?rev=1915&view=rev Author: ron-fox Date: 2011-12-06 15:10:39 +0000 (Tue, 06 Dec 2011) Log Message: ----------- - Complete the array checkbox implementation. - Add tab navigation to both the sprint and to the application. Modified Paths: -------------- trunk/SpecTcl/treegui/parametersTabActions.tcl trunk/SpecTcl/treegui/treeParameterWidget.tcl Modified: trunk/SpecTcl/treegui/parametersTabActions.tcl =================================================================== --- trunk/SpecTcl/treegui/parametersTabActions.tcl 2011-12-05 18:53:51 UTC (rev 1914) +++ trunk/SpecTcl/treegui/parametersTabActions.tcl 2011-12-06 15:10:39 UTC (rev 1915) @@ -254,6 +254,38 @@ return $result } + ## + # Get the parameters list affected if an array checkbox might expand the list: + # @param path - the path of the parameter we are possibly expanding. + # @return list + # @retval actual set of affected parameters. + # @note the -array configuration option of the editor widget determines + # whether or not we can expand the list. + # @note If array is checked but the parameter is not an array element the parameter + # itself is returned. + # + private method getTargetParameters path { + # + # If the array button is checked we need to do + # This for a bunch of parameters potentially + # + + if {[$widget cget -array]} { + set parameters [listArrayElements $path] + + # If the list is empty, then treat this as if the + # parameter is not an array and it's as if the array checkbox was + # not selected: + + if {[llength $parameters] == 0} { + set parameters [list $path] + } + } else { + set parameters [list $path] + } + return $parameters + } + #----------------------------------------------------------------------------- # Dialogs: @@ -367,8 +399,17 @@ set inc [expr {(1.0*$hi - $low)/$bins}] - treeparameter -set $path $bins $low $hi $inc $units + # Enumerate the paths to set. If the + # array checkbutton is checked we must treat this as + # an array. + + set parameters [getTargetParameters $path] + + foreach parameter $parameters { + treeparameter -set $parameter $bins $low $hi $inc $units + } + } } @@ -395,14 +436,38 @@ set low [lindex $currentInfo 2] set hi [lindex $currentInfo 3] - set spectra [listDependentSpectra $path] + # Potentially expand the parameter list: + set parameters [getTargetParameters $path] + + # We need to figure out + # - The set of spectra that depend on each parameter in the list. + # - The merged set of spectra we'll modify. + # This will be done by creating an array indexed by spectrum to be + # modified with a list of parameters that cause the spectrum to be modified + # as the value: + # + array set spectraModified [list] + foreach parameter $parameters { + set spectra [listDependentSpectra $parameter] + foreach spectrum $spectra { + lappend spectraModified($spectrum) $parameter + } + } + # The list of specta modified is therefore: + + set spectra [array names spectraModified] + # Get confirmation: if {[llength $spectra] > 0} { if {[promptChangeOk $spectra]} { - modifySpectra $spectra $path $low $hi + foreach spectrum [array names spectraModified] { + foreach parameter $spectraModified($spectrum) { + modifySpectra $spectrum $parameter $low $hi + } + } } } else { notifyNoMatches Modified: trunk/SpecTcl/treegui/treeParameterWidget.tcl =================================================================== --- trunk/SpecTcl/treegui/treeParameterWidget.tcl 2011-12-05 18:53:51 UTC (rev 1914) +++ trunk/SpecTcl/treegui/treeParameterWidget.tcl 2011-12-06 15:10:39 UTC (rev 1915) @@ -39,6 +39,12 @@ # # METHODS: # resetChanged - Turn off changed flag (this can be done by save). +# BINDINGS +# <Tab> Moves focus forward to the next field (ring style). +# <Shift-Tab> Moves the focus forward to the next field. +# <Return> Moves the focus forward to the next field. +# <Right> Moves focus forward to the next field. +# <Left> Moves focus back to the prior field. # # @@ -54,7 +60,15 @@ option -changecmd [list] option -title false; # If true titles are put above the text entries. + # The variable below is the focus order ring: + # It allows us to build methods focusLeft and focusRight that shift focus + # the appropriate direction around the ring. + # Note that $win is not necessarily defined here so we just put the widget + # name tails: + variable focusRing [list .name .low .high .unit] + + ## # Constructor -- see the summary comments above the class. # @param args - an option/value list. @@ -76,14 +90,25 @@ set editorRow 1 } - # First the labels: + # First the entries... set the bindings on them as well: - foreach label [list .name .low .high .unit] optionname [list -name -low -high -units] \ + foreach entry [list .name .low .high .unit] optionname [list -name -low -high -units] \ width [list 32 5 5 10] { - ::ttk::entry $win$label -textvariable ${selfns}::options($optionname) \ - -width $width + ::ttk::entry $win$entry -textvariable ${selfns}::options($optionname) \ + -width $width + + # Bindings that move focus right: + + foreach binding [list <Tab> <Return> <Right>] { + bind $win$entry $binding [list after 2 [mymethod focusRight $entry]] + } + # Bindings that move focus left: + + foreach binding [list <Shift-Tab> <Left> <ISO_Left_Tab>] { + bind $win$entry $binding [list after 2 [mymethod focusLeft $entry]] + } } - + # then the buttons: foreach button [list .load .set .changespectra] \ @@ -125,4 +150,27 @@ } } + ## + # Change focus to the next widget in the ring. + # @param tail tail of current widgetname... actual widget is $win.$tail + # + method focusRight tail { + set currentIndex [lsearch -exact $focusRing $tail] + set nextIndex [expr {($currentIndex+1) % [llength $focusRing]}] + set nextWidget $win[lindex $focusRing $nextIndex] + + focus $nextWidget + } + ## + # Change the focus to the prior widget in the focus ring. + # @param tail + # + method focusLeft tail { + set currentIndex [lsearch -exact $focusRing $tail] + set nextIndex [expr {($currentIndex-1) % [llength $focusRing]}] + set nextWidget $win[lindex $focusRing $nextIndex] + + focus $nextWidget + + } } \ No newline at end of file This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ro...@us...> - 2011-12-09 14:33:40
|
Revision: 1926 http://nsclspectcl.svn.sourceforge.net/nsclspectcl/?rev=1926&view=rev Author: ron-fox Date: 2011-12-09 14:33:29 +0000 (Fri, 09 Dec 2011) Log Message: ----------- Sort order indicator glyphs Added Paths: ----------- trunk/SpecTcl/treegui/downarrow.gif trunk/SpecTcl/treegui/uparrow.gif Added: trunk/SpecTcl/treegui/downarrow.gif =================================================================== (Binary files differ) Property changes on: trunk/SpecTcl/treegui/downarrow.gif ___________________________________________________________________ Added: svn:mime-type + application/octet-stream Added: trunk/SpecTcl/treegui/uparrow.gif =================================================================== (Binary files differ) Property changes on: trunk/SpecTcl/treegui/uparrow.gif ___________________________________________________________________ Added: svn:mime-type + application/octet-stream This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ro...@us...> - 2011-12-09 18:43:50
|
Revision: 1927 http://nsclspectcl.svn.sourceforge.net/nsclspectcl/?rev=1927&view=rev Author: ron-fox Date: 2011-12-09 18:43:43 +0000 (Fri, 09 Dec 2011) Log Message: ----------- Debug the gates tab actions adding code as needd to the other megawidgets. Modified Paths: -------------- trunk/SpecTcl/treegui/gateCreate.tcl trunk/SpecTcl/treegui/gateDeleteBar.tcl trunk/SpecTcl/treegui/gateSelBar.tcl trunk/SpecTcl/treegui/gateTable.tcl Added Paths: ----------- trunk/SpecTcl/treegui/gateContainer.tcl trunk/SpecTcl/treegui/gateTabActions.tcl Added: trunk/SpecTcl/treegui/gateContainer.tcl =================================================================== --- trunk/SpecTcl/treegui/gateContainer.tcl (rev 0) +++ trunk/SpecTcl/treegui/gateContainer.tcl 2011-12-09 18:43:43 UTC (rev 1927) @@ -0,0 +1,142 @@ +# This software is Copyright by the Board of Trustees of Michigan +# State University (c) Copyright 2009. +# +# You may use this software under the terms of the GNU public license +# (GPL). The terms of this license are described at: +# +# http://www.gnu.org/licenses/gpl.txt +# +# Author: +# Ron Fox +# NSCL +# Michigan State University +# East Lansing, MI 48824-1321 + +package require Tk +package require snit +package require gateCreate +package require gateDeleteBar +package require gateTable +package require gateSelBar + + + +package provide gateContainer 1.0 + + +## +# This provides a snit megawidget that encapsulates the gate tab. +# The main purpose of this class is to encapsulate behavior betweeen +# the widgets while only exporting callbacks that require interaction +# with SpecTcl (the model) back to the controller class. +# +# Layout is just a simple top to bottom one; +# +----------------------------------+ +# | gateCreate widget | +# +----------------------------------+ +# | gateDeleteBar | +# +----------------------------------+ +# | gateTable widget. | +# +----------------------------------+ +# | gateSelBar | +# +----------------------------------+ +# +# OPTIONS: +# +# Delegated to the gateSelBar : +# -updatecmd - Script to run when the update gates list button is clicked. +# -maskcmd - Script to run when the mask has changed. +# +# For both of these %M substitutes with the current value of the mask. +# +# Delegated to the gateTable: +# -gates - Returns/sets the gates in the table. +# -command - Gate double clicked %N substitutes for the gate name clicked. +# +# Delegated to the gateDeleteBar: +# +# - deleteselected - script invoked when the "Delete Selected" button is clicked. +# - deleteall - script invoked when the Delete All button is clicked. +# +# Delegated to gateCreate: +# -createcmd - Script invoked when the create/replace button is clicked. +# %G %T %D substitutions as documented in gateCreate.tcl +# -menugates - Delegated to -gates; Used to populate the gate dropdown. +# this normally is populated with all of the gates rather than +# just the masked set in the table. +# -type - gate type (SpecTcl) +# -gatename - Gate name +# -definition - Gate definition. +# -typename - Gate typename +# +# METHODS: +# +# Delegated to the gateTable +# +# getsel - Returns the gates that are selected. +# +# AUTONOMOUS ACTIONS: +# Double clicking a gate in the gateTable widget loads its definition into the +# gateCreate widget fields. +# +snit::widget gateContainer { + hulltype ttk::frame + + # Options handled by the gateSelBar widget: + + delegate option -updatecmd to gatemask + delegate option -maskcmd to gatemask + delegate option -mask to gatemask + + # Options handled by the gate table widget: + + delegate option -gates to gatetable + delegate option -command to gatetable + + # Options handled by the delete bar: + + delegate option -deleteselected to gatedelete + delegate option -deleteall to gatedelete + + # Options delegated to the gate creator: + + delegate option -createcmd to gatecreate + delegate option -menugates to gatecreate as -gates + delegate option -gatename to gatecreate + delegate option -definition to gatecreate + delegate option -type to gatecreate + delegate option -typename to gatecreate + + delegate option * to gatetable; # remaining opts configure the table. + + # Methods delegated to gateTable: + + delegate method getsel to gatetable + + + ## + # Construct the widget. + # We must construct and layout the widget prior to processing options. + # + # @param args option name value pairs list. + # + constructor args { + puts gateSelBar + install gatemask using gateSelBar $win.gatesel + install gatetable using gateTable $win.gatetable + install gatedelete using gateDeleteBar $win.gatedelete + install gatecreate using gateCreate $win.gatecreate + + + grid $win.gatecreate -sticky ew + grid $win.gatedelete -sticky ew + grid $win.gatetable -sticky ew + grid $win.gatesel -sticky ew + + + $self configurelist $args + } + + + +} Modified: trunk/SpecTcl/treegui/gateCreate.tcl =================================================================== --- trunk/SpecTcl/treegui/gateCreate.tcl 2011-12-09 14:33:29 UTC (rev 1926) +++ trunk/SpecTcl/treegui/gateCreate.tcl 2011-12-09 18:43:43 UTC (rev 1927) @@ -18,7 +18,7 @@ package require snit package require treemenuWidget -package provide gateCreate +package provide gateCreate 1.0 ## # Provides a megawidget for creating gates. @@ -58,8 +58,8 @@ option -createcmd option -gatename option -definition - option -type - option -typename + option -type -configuremethod SetTypename + option -typename -configuremethod SetType option -gates -configuremethod SetGates # Dictionary whose keys populate the gate type menu @@ -173,7 +173,42 @@ destroy $win.gatesel.gates treeMenu $win.gatesel.gates -command [mymethod AddDependency %N] -items $value } + ## Modify the -typename option this option is coupled to the -tyep option + # Via the gateTypes dict. + # + # @param option - the option being modified: -typename. + # @param value - the new value. + # + method SetType {option value} { + # Ensure the value is legal: + if {![dict exists $gateTypes $value]} { + error "$value is not a valid gate type string" + } + + set options($option) $value + set optinos(-type) [dict get $gateTypes $value] + } + ## + # Modify the -type option. This option is coupled to the -typename option + # via the gateTypes dict + # -type are values and -typename s are keys to that dict. + # + # @param option - the option being modified (-type). + # @param value - new value. + # + method SetTypename {option value} { + # + # The value must exist in the dict: + + set subdict [dict filter $gateTypes value $value] + if {[llength $subdict] == 0} { + error "$value is not a valid SpecTcl gate type" + } + set options($option) $value + set options(-typename) [lindex [dict keys $subdict] 0] + } + #-------------------------------------------------------------------- # # Internal methods that provide autonomous behavior. Modified: trunk/SpecTcl/treegui/gateDeleteBar.tcl =================================================================== --- trunk/SpecTcl/treegui/gateDeleteBar.tcl 2011-12-09 14:33:29 UTC (rev 1926) +++ trunk/SpecTcl/treegui/gateDeleteBar.tcl 2011-12-09 18:43:43 UTC (rev 1927) @@ -15,7 +15,7 @@ package require Tk package require snit -package provide gateDeleteBar +package provide gateDeleteBar 1.0 ## # Provides a megawidget that contains the @@ -27,6 +27,7 @@ # # snit::widget gateDeleteBar { + hulltype ttk::frame option -deleteselected -default [list] option -deleteall -default [list] @@ -45,7 +46,8 @@ ttk::button $win.delall -text "Delete All" \ -command [mymethod Dispatch -deleteall] - grid $win.delsel $win.delall -sticky w + grid $win.delsel -sticky w + grid $win.delall -row 0 -column 1 -sticky e } ## Modified: trunk/SpecTcl/treegui/gateSelBar.tcl =================================================================== --- trunk/SpecTcl/treegui/gateSelBar.tcl 2011-12-09 14:33:29 UTC (rev 1926) +++ trunk/SpecTcl/treegui/gateSelBar.tcl 2011-12-09 18:43:43 UTC (rev 1927) @@ -30,6 +30,7 @@ # OPTIONS # -updatecmd - Script to run when the "Update Gate List" button is clicked. # -maskcmd - Script to run when the gate mask changes. +# -mask - Current value of the mask. # # Note that if the Clear button is clicked it will set the Gate mask to # * autonomously and invoke the -maskcmd script. @@ -43,6 +44,7 @@ option -updatecmd [list] option -maskcmd [list] + option -mask -readonly true -cgetmethod GetMask ## @@ -73,7 +75,17 @@ $win.mask insert 0 * } + #------------------------------------------------------------------------ + # Configuration management. + ## + # Retrieve the current value of the mask + # + # @param option - the option to retrieve ..must be -mask + # + method GetMask option { + return [$win.mask get] + } #-------------------------------------------------------------------------- # Event handlers: @@ -87,7 +99,7 @@ if {$script ne ""} { - regsub "%M" $script [$win.mask get] script + regsub "%M" $script [list [$win.mask get]] script uplevel #0 $script } } Added: trunk/SpecTcl/treegui/gateTabActions.tcl =================================================================== --- trunk/SpecTcl/treegui/gateTabActions.tcl (rev 0) +++ trunk/SpecTcl/treegui/gateTabActions.tcl 2011-12-09 18:43:43 UTC (rev 1927) @@ -0,0 +1,243 @@ +# This software is Copyright by the Board of Trustees of Michigan +# State University (c) Copyright 2009. +# +# You may use this software under the terms of the GNU public license +# (GPL). The terms of this license are described at: +# +# http://www.gnu.org/licenses/gpl.txt +# +# Author: +# Ron Fox +# NSCL +# Michigan State University +# East Lansing, MI 48824-1321 + +package require Tk +package require Itcl +package require gateContainer + +package provide gateTabActions 1.0 + + + +## +# Provides an itcl class that encapsulates the behavior of the gates container. +# Construction of the class will instatiate the container widget on the +# specified .widget but will not make it visible. Making it visible is the +# client's job. gate add/delete traces are used to update the gate name menu in the +# create bar..gate table updates are driven by callbacks from the gate mask bar at the +# bottom of the megawidget. +# +# OPTIONS: +# -widget - Name of gate container widget to create. +# +::itcl::class gateTabActions { + public variable widget "" + + #------------------------------------------------------------------------------ + # Private methods: + + ## + # Return the type code of a gate: + # @param gate - the gate to parse. + # + private method gateType gate { + return [lindex $gate 2] + } + ## + # Updates both the gate table and the gate menu using the mask: + # + private method updateGates {} { + loadGateTable [$widget cget -mask] + loadGateMenu + + } + ## + # The primitive gates need to have their definitions munged a bit + # when being loaded into the definition string entry. This is because gate -list + # provides [list param1 param2] [list x1 y1] [list x2 y2]...] + # but the definition requires: + # [list param1 param2 [list [list x1 y1] [list x2 y2]...]] + # @param def - original def + # @return list + # @retval - the list that the gate creation command expects. + # + method mungGateDefinition def { + set params [lindex $def 0] + set coords [lrange $def 1 end] + + set xParam [lindex $params 0] + set yParam [lindex $params 1] + + set def [list $xParam $yParam] + lappend def $coords + + return $def + } + + #------------------------------------------------------------------------------- + # + # Callbacks.. These must be public as they're called at global level: + # + + ## + # Load the gate table with the set of gates specified by the mask. + # + # @param mask - Glob pattern used to select the gates to modify. + # + # @note false gates are not listed as they are assumed to represent deleted gates + # + public method loadGateTable mask { + set gates [list] + foreach gate [gate -list $mask] { + if {[gateType $gate] ne "F"} { + lappend gates $gate + } + } + $widget configure -gates $gates + } + + ## + # Load the gate menu with the names of all of the gates: + # @param args - I get passed parameters by the gate trace callback which I want to ignore. + public method loadGateMenu {args} { + set gates [gate -list] + set names [list] + foreach gate $gates { + if {[gateType $gate] ne "F"} { + lappend names [lindex $gate 0] + } + } + $widget configure -menugates $names + } + + + ## + # Called when a gate is double clicked in the gate table. + # Ths loads the gate specification into the gate creation widget. + # @param name - gate name. + # + public method loadGateSpec name { + set gateSpec [gate -list $name] + + if {([llength $gateSpec] != 0)} { + set gateSpec [lindex $gateSpec 0] + + set type [gateType $gateSpec] + if {$type == "F"} { + + # Deleted gate + + set def "" + set type [$widget cget -type] + } else { + + set def [lindex $gateSpec 3] + + # Bands and contours have to be handled differently + # Because of the fact that their gate -list is slightly + # different than their gate definition. + + if {$type in {b c}} { + set def [mungGateDefinition $def] + } + } + + $widget configure -gatename $name -type $type -definition $def + + } else { + # the gate does not exist for whatever reason: + + $widget configure -gatename $name -definition "" + } + + } + ## + # Delete the gate(s) that are currently selected in the table. + # An update using the current mask is also forced. + # + public method deleteSelected {} { + set gates [$widget getsel] + foreach gate $gates { + gate -delete $gate + } + updateGates + } + ## + # Prompt for confirmation and, if we get it, delete all of the + # gates + # + public method deleteAll {} { + set confirmation [tk_messageBox -type yesno -icon warning \ + -message "Are you sure you want to delete all the gate definitions?" \ + -default no] + if {$confirmation == "yes"} { + foreach gate [gate -list] { + # + # Only bother for those that are already deleted: + # + if {[gateType $gate] != "F"} { + gate -delete [lindex $gate 0] + } + } + updateGates + } + } + ## + # Callback invoked to create/modify a gate. + # @param name - Name of the gate. + # @param gateType - SpecTcl gate type. + # @param definition - Gate definition string. + # + # + public method createGate {name gateType definition} { + + # Require that the gate name, type and definition are not null. + # + if {($name eq "" ) || ($gateType eq "") || ($definition eq "")} { + tk_messageBox -type ok -message "Gate is not completely defined" -icon error + } else { + if {[catch {gate $name $gateType $definition}]} { + tk_messageBox -type ok -message "Incorrect gate definition for gate type" -icon error + } else { + updateGates + } + } + } + #------------------------------------------------------------------------------- + # Public interfaces + # + + ## + # construct the megawidget and set up the callbacks/options. + # Initially the table is loaded with the gates that are defined now + # As selected by the mask. + # The gates dropdown is loaded from the names of all gates. + # + # @param args - list of option/value pairs + # + constructor {args} { + eval configure $args; # Ensure the widget name is set: + if {$widget eq ""} { + error "The -widget option is mandator" + } + + gateContainer $widget -height 20 \ + -maskcmd [list $this loadGateTable %M] \ + -updatecmd [list $this loadGateTable %M] \ + -command [list $this loadGateSpec %N] \ + -deleteselected [list $this deleteSelected] \ + -deleteall [list $this deleteAll] \ + -createcmd [list $this createGate %G %T %D] + + loadGateTable * + loadGateMenu + + # Set up a gate add/delete trace to reload the gate menu: + + gate -trace add [list $this loadGateMenu] + gate -trace delete [list $this loadGateMenu] + gate -trace change [list $this loadGateMenu]; # in case change was type -> false. + + } +} \ No newline at end of file Modified: trunk/SpecTcl/treegui/gateTable.tcl =================================================================== --- trunk/SpecTcl/treegui/gateTable.tcl 2011-12-09 14:33:29 UTC (rev 1926) +++ trunk/SpecTcl/treegui/gateTable.tcl 2011-12-09 18:43:43 UTC (rev 1927) @@ -118,7 +118,17 @@ $win.t heading $column -text $column -command [mymethod changeSort $column] -anchor w } ttk::scrollbar $win.s -command [list $win.t yview] + # + # Make the gate type column thin an set the Definition column to stretch + # Put the additional pixels into the definition column + set originalDef [$win.t column Definition -width] + set typeWidth [$win.t column Type -width] + incr originalDef [expr {$typeWidth - 50}] + + $win.t column Type -width 50; # Too bad this can't be in chars. + $win.t column Definition -stretch true -width $originalDef + $win.t heading Name -image $uparrow # Lay them out @@ -416,9 +426,9 @@ # Select the glyph: if {$dir eq "ascending"} { + set image $downarrow + } else { set image $uparrow - } else { - set image $downarrow } foreach column [list Name Type Definition] { set c [string tolower $column] This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ro...@us...> - 2011-12-12 19:32:47
|
Revision: 1929 http://nsclspectcl.svn.sourceforge.net/nsclspectcl/?rev=1929&view=rev Author: ron-fox Date: 2011-12-12 19:32:38 +0000 (Mon, 12 Dec 2011) Log Message: ----------- As per work item 111 Modified Paths: -------------- trunk/SpecTcl/treegui/treeVariableEditor.tcl Added Paths: ----------- trunk/SpecTcl/treegui/treeVariableContainer.tcl Added: trunk/SpecTcl/treegui/treeVariableContainer.tcl =================================================================== --- trunk/SpecTcl/treegui/treeVariableContainer.tcl (rev 0) +++ trunk/SpecTcl/treegui/treeVariableContainer.tcl 2011-12-12 19:32:38 UTC (rev 1929) @@ -0,0 +1,57 @@ +# This software is Copyright by the Board of Trustees of Michigan +# State University (c) Copyright 2009. +# +# You may use this software under the terms of the GNU public license +# (GPL). The terms of this license are described at: +# +# http://www.gnu.org/licenses/gpl.txt +# +# Author: +# Ron Fox +# NSCL +# Michigan State University +# East Lansing, MI 48824-1321 + + + +package require Tk +package require snit +package require treeVariableEditor + +package provide treeVariableContainer 1.0 + +## +# Contains tree variables editors and the load/save strip at the bottom of that widget. +# +# OPTIONS: +# -variables - Delegated to treeVariableEditor. +# -lines - Delegated to treeVariableEditor. +# -current - Delegated to treeVariableEditor. +# -selectcmd - Delegated to treeVariableEditor. +# + +snit::widget treeVariableContainer { + hulltype ttk::frame + + delegate option -variables to editors + delegate option -lines to editors + delegate option -current to editors + delegate option -selectcmd to editors + + ## + # install the components and lay them out. + # + # @param args - option value sets that determine the initial configuration of the + # widget. + # + constructor args { + + install editors as treeVariableEditor $win.editors + + $self configurelist $args + + + grid $win.editors + + } +} Modified: trunk/SpecTcl/treegui/treeVariableEditor.tcl =================================================================== --- trunk/SpecTcl/treegui/treeVariableEditor.tcl 2011-12-12 19:07:02 UTC (rev 1928) +++ trunk/SpecTcl/treegui/treeVariableEditor.tcl 2011-12-12 19:32:38 UTC (rev 1929) @@ -118,7 +118,6 @@ # @param path - Path to the selected item. # method SelectVariable {label path} { - puts "SelectVariable" set script $options(-selectcmd) $self Dispatch $script [list %W %L %N %I] [list $win $label $path $options(-current)] @@ -136,13 +135,10 @@ # @pram values - For each element of substs a value that can be plugged into the script # method Dispatch {script substs values} { - puts Dispatch if {$script ne ""} { - puts non-null foreach subst $substs value $values { regsub -all $subst $script $value script } - puts $script uplevel #0 $script } } This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ro...@us...> - 2011-12-12 20:10:17
|
Revision: 1930 http://nsclspectcl.svn.sourceforge.net/nsclspectcl/?rev=1930&view=rev Author: ron-fox Date: 2011-12-12 20:10:11 +0000 (Mon, 12 Dec 2011) Log Message: ----------- Completed workitem 112. Modified Paths: -------------- trunk/SpecTcl/treegui/treeVariableContainer.tcl trunk/SpecTcl/treegui/treeVariableEditor.tcl Added Paths: ----------- trunk/SpecTcl/treegui/variableTabActions.tcl Modified: trunk/SpecTcl/treegui/treeVariableContainer.tcl =================================================================== --- trunk/SpecTcl/treegui/treeVariableContainer.tcl 2011-12-12 19:32:38 UTC (rev 1929) +++ trunk/SpecTcl/treegui/treeVariableContainer.tcl 2011-12-12 20:10:11 UTC (rev 1930) @@ -38,6 +38,8 @@ delegate option -current to editors delegate option -selectcmd to editors + delegate method loadEditor to editors + ## # install the components and lay them out. # Modified: trunk/SpecTcl/treegui/treeVariableEditor.tcl =================================================================== --- trunk/SpecTcl/treegui/treeVariableEditor.tcl 2011-12-12 19:32:38 UTC (rev 1929) +++ trunk/SpecTcl/treegui/treeVariableEditor.tcl 2011-12-12 20:10:11 UTC (rev 1930) @@ -46,7 +46,8 @@ # a variable. Substitutions include the normal substitutions available to # tree menu widgets (%W - which is our widget, however, %L menu label. # %N full path to the menu as well as %I - Currently selected editor line. -# +# METHODS: +# loadEditor - Loads the contents of a specific editor. snit::widget treeVariableEditor { hulltype ttk::frame @@ -87,8 +88,27 @@ grid $win.radio$row $win.name$row $win.value$row $win.units$row $win.load$row $win.set$row } + } + #------------------------------------------------------------------------------ + # Public methods: + ## + # Load an editor with a tree parameter: + # @param editor - index of the specific editor. + # @param name - Name of the tree variable. + # @param value - Value of the tree variable. + # @param units - Units of the tree variable. + # + + method loadEditor {editor name value units} { + foreach widget [list $win.name$editor $win.value$editor $win.units$editor] \ + value [list $name $value $units] { + $widget delete 0 end + $widget insert 0 $value + } } + + #------------------------------------------------------------------------------- # # Configuration handlers: Added: trunk/SpecTcl/treegui/variableTabActions.tcl =================================================================== --- trunk/SpecTcl/treegui/variableTabActions.tcl (rev 0) +++ trunk/SpecTcl/treegui/variableTabActions.tcl 2011-12-12 20:10:11 UTC (rev 1930) @@ -0,0 +1,89 @@ +# This software is Copyright by the Board of Trustees of Michigan +# State University (c) Copyright 2009. +# +# You may use this software under the terms of the GNU public license +# (GPL). The terms of this license are described at: +# +# http://www.gnu.org/licenses/gpl.txt +# +# Author: +# Ron Fox +# NSCL +# Michigan State University +# East Lansing, MI 48824-1321 + +package require Tk +package require Itcl +package require treeVariableContainer + +package provide variableTabActions 1.0 + +## +# Provides the behavior associated with the tree variables editor tab. +# OPTIONS +# -widget - specifies the widget name of the treeVariableContainer that is the +# view. Constructing this class creates the widget but it is up to the +# caller to determine how to manage it. +# + +itcl::class variableTabActions { + + public variable widget + public variable lines 20 + + #------------------------------------------------------------------ + # Private support functions. + + ## + # Return a list of the tree variable names. + # @return list + # @retval list of tree variable names. + + private method treeVariableNames {} { + set result [list] + + foreach variable [treevariable -list] { + lappend result [lindex $variable 0] + } + + return $result + } + + #------------------------------------------------------------------- + # Callbacks (note these must be public to work + + ## + # Called when a variable is selected from the tree menu, + # The variable is loaded into the currently seleted editor. + # @param name - tree variable name. + # @param index - Current editor number. + + + public method LoadVariable {path index} { + set definition [treevariable -list $path] + if {[llength $definition] != 0} { + set definition [lindex $definition 0] + $widget loadEditor $index [lindex $definition 0] [lindex $definition 1] [lindex $definition 2] + } + } + + #-------------------------------------------------------------------- + # public interface + + ## + # Construct us. + # @param args - set of optino values to use in constructing us. + # + constructor args { + eval configure $args; # set the widget name and lines. + + if {$widget eq ""} { + error "The -widget option is mandatory" + } + + treeVariableContainer $widget -lines $lines -selectcmd [list $this LoadVariable %N %I] \ + -variables [$this treeVariableNames] + } + + +} This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ro...@us...> - 2011-12-12 20:22:35
|
Revision: 1931 http://nsclspectcl.svn.sourceforge.net/nsclspectcl/?rev=1931&view=rev Author: ron-fox Date: 2011-12-12 20:22:29 +0000 (Mon, 12 Dec 2011) Log Message: ----------- Completed work items 113, 114 Modified Paths: -------------- trunk/SpecTcl/treegui/treeVariableContainer.tcl trunk/SpecTcl/treegui/treeVariableEditor.tcl trunk/SpecTcl/treegui/variableTabActions.tcl Modified: trunk/SpecTcl/treegui/treeVariableContainer.tcl =================================================================== --- trunk/SpecTcl/treegui/treeVariableContainer.tcl 2011-12-12 20:10:11 UTC (rev 1930) +++ trunk/SpecTcl/treegui/treeVariableContainer.tcl 2011-12-12 20:22:29 UTC (rev 1931) @@ -37,6 +37,7 @@ delegate option -lines to editors delegate option -current to editors delegate option -selectcmd to editors + delegate option -loadcmd to editors delegate method loadEditor to editors Modified: trunk/SpecTcl/treegui/treeVariableEditor.tcl =================================================================== --- trunk/SpecTcl/treegui/treeVariableEditor.tcl 2011-12-12 20:10:11 UTC (rev 1930) +++ trunk/SpecTcl/treegui/treeVariableEditor.tcl 2011-12-12 20:22:29 UTC (rev 1931) @@ -46,6 +46,12 @@ # a variable. Substitutions include the normal substitutions available to # tree menu widgets (%W - which is our widget, however, %L menu label. # %N full path to the menu as well as %I - Currently selected editor line. +# -loadcmd - script that is invoked when the load button is clicked. +# Substitutions include: +# - %N name of widget loaded into the editor. +# - %I Index of the editor that invoked this. +# - %W $win. +# # METHODS: # loadEditor - Loads the contents of a specific editor. @@ -55,6 +61,7 @@ option -lines -default 20 option -current -default 1 option -selectcmd -default [list] + option -loadcmd -default [list] ## #Create/layout the widgets and set up the callbacks and bindings. @@ -83,7 +90,7 @@ ttk::entry $win.name$row -width 32 ttk::entry $win.value$row -width 10 ttk::entry $win.units$row -width 10 - ttk::button $win.load$row -text Load + ttk::button $win.load$row -text Load -command [mymethod ReloadDispatch $row] ttk::button $win.set$row -text Set grid $win.radio$row $win.name$row $win.value$row $win.units$row $win.load$row $win.set$row @@ -143,6 +150,21 @@ $self Dispatch $script [list %W %L %N %I] [list $win $label $path $options(-current)] } + ## + # ReloadDispatch - dispatches the -loadcmd. See the comment header for the set of + # substitutions supported. + # + # @param row - Number of the selected editor. + # + method ReloadDispatch row { + set name [$win.name$row get] + + # Only dispatch if there's a non-empty name: + + if {$name ne ""} { + $self Dispatch $options(-loadcmd) [list %W %N %I] [list $win $name $row] + } + } #--------------------------------------------------------------------- # Private utilities. # Modified: trunk/SpecTcl/treegui/variableTabActions.tcl =================================================================== --- trunk/SpecTcl/treegui/variableTabActions.tcl 2011-12-12 20:10:11 UTC (rev 1930) +++ trunk/SpecTcl/treegui/variableTabActions.tcl 2011-12-12 20:22:29 UTC (rev 1931) @@ -67,6 +67,7 @@ } } + #-------------------------------------------------------------------- # public interface @@ -82,7 +83,8 @@ } treeVariableContainer $widget -lines $lines -selectcmd [list $this LoadVariable %N %I] \ - -variables [$this treeVariableNames] + -variables [$this treeVariableNames] \ + -loadcmd [list $this LoadVariable %N %I] } This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ro...@us...> - 2011-12-12 21:49:56
|
Revision: 1932 http://nsclspectcl.svn.sourceforge.net/nsclspectcl/?rev=1932&view=rev Author: ron-fox Date: 2011-12-12 21:49:50 +0000 (Mon, 12 Dec 2011) Log Message: ----------- - Complete work items 119, 120. - Factor out array element generation from parametersTabAction and variableTabActions -> treeUtilities.tcl Modified Paths: -------------- trunk/SpecTcl/treegui/parametersTabActions.tcl trunk/SpecTcl/treegui/treeVariableContainer.tcl trunk/SpecTcl/treegui/treeVariableEditor.tcl trunk/SpecTcl/treegui/variableTabActions.tcl Added Paths: ----------- trunk/SpecTcl/treegui/treeUtilities.tcl Modified: trunk/SpecTcl/treegui/parametersTabActions.tcl =================================================================== --- trunk/SpecTcl/treegui/parametersTabActions.tcl 2011-12-12 20:22:29 UTC (rev 1931) +++ trunk/SpecTcl/treegui/parametersTabActions.tcl 2011-12-12 21:49:50 UTC (rev 1932) @@ -15,6 +15,7 @@ package require Tk package require Itcl package require treeParametersContainer +package require treeUtilities package provide parametersTabActions 1.0 @@ -40,20 +41,7 @@ # Private Methods: # - ## - # Get a list of the tree parameter names: - # - private method parameterList {} { - set treeParameters [treeparameter -list] - set result [list] - foreach param $treeParameters { - lappend result [lindex $param 0] - } - - return $result - } - ## # Load a specific parameter slot with data: # @param slot - the slot to load. @@ -232,26 +220,8 @@ # private method listArrayElements sampleName { - # So happens that the last element in the path looks like a file extension so - # we can use [file rootname] to get the rest of it. - set prefix [file rootname $sampleName] - set prefixlen [llength [split $prefix .]] - append prefix . + return [::treeutility::listArrayElements $sampleName [list $this parameterList]] - set candidates [treeparameter -list $prefix*]; # list only the stuff that starts out right. - - # For matching purposes we need to - - set result [list] - foreach candidate $candidates { - set name [lindex $candidate 0] - set end [join [lrange [split $name .] $prefixlen end]] - - if {[regexp -- {^\.([0-9])+$} .$end]} { - lappend result $name - } - } - return $result } ## @@ -475,5 +445,18 @@ } } + ## + # Get a list of the tree parameter names: + # + public method parameterList {{pattern *}} { + set treeParameters [treeparameter -list $pattern] + set result [list] + + foreach param $treeParameters { + lappend result [lindex $param 0] + } + + return $result + } } Added: trunk/SpecTcl/treegui/treeUtilities.tcl =================================================================== --- trunk/SpecTcl/treegui/treeUtilities.tcl (rev 0) +++ trunk/SpecTcl/treegui/treeUtilities.tcl 2011-12-12 21:49:50 UTC (rev 1932) @@ -0,0 +1,55 @@ +# This software is Copyright by the Board of Trustees of Michigan +# State University (c) Copyright 2009. +# +# You may use this software under the terms of the GNU public license +# (GPL). The terms of this license are described at: +# +# http://www.gnu.org/licenses/gpl.txt +# +# Author: +# Ron Fox +# NSCL +# Michigan State University +# + +# This file contains open functions in the 'treeutility' namespace that +# factor common code out of the various tab actions etc. +# + +package provide treeUtilities 1.0 + +namespace eval ::treeutility { +} + +## +# Given a callback that generates names from a glob pattern +# and a sample array element, returns the names of all array elements. +# From the tree parameter point of view, an array element is +# something of the regexp form prefix.\d+$ where 'prefix' can be just about anything. +# +# @param sampleName - The sample array name. +# @param generator - Command that will generate a list of names from a glob pattern. +# +proc ::treeutility::listArrayElements {sampleName generator} { + + # So happens that the last element in the path looks like a file extension so + # we can use [file rootname] to get the rest of it. + set prefix [file rootname $sampleName] + set prefixlen [llength [split $prefix .]] + append prefix . + + set candidates [{*}$generator $prefix*]; # list only the stuff that starts out right. + + # For matching purposes we need to match elements that start with the prefix + # and end with .digits. + + set result [list] + foreach name $candidates { + set end [join [lrange [split $name .] $prefixlen end]] + + if {[regexp -- {^\.([0-9])+$} .$end]} { + lappend result $name + } + } + return $result +} \ No newline at end of file Modified: trunk/SpecTcl/treegui/treeVariableContainer.tcl =================================================================== --- trunk/SpecTcl/treegui/treeVariableContainer.tcl 2011-12-12 20:22:29 UTC (rev 1931) +++ trunk/SpecTcl/treegui/treeVariableContainer.tcl 2011-12-12 21:49:50 UTC (rev 1932) @@ -38,6 +38,8 @@ delegate option -current to editors delegate option -selectcmd to editors delegate option -loadcmd to editors + delegate option -setcmd to editors + delegate option -array to editors delegate method loadEditor to editors Modified: trunk/SpecTcl/treegui/treeVariableEditor.tcl =================================================================== --- trunk/SpecTcl/treegui/treeVariableEditor.tcl 2011-12-12 20:22:29 UTC (rev 1931) +++ trunk/SpecTcl/treegui/treeVariableEditor.tcl 2011-12-12 21:49:50 UTC (rev 1932) @@ -48,9 +48,17 @@ # %N full path to the menu as well as %I - Currently selected editor line. # -loadcmd - script that is invoked when the load button is clicked. # Substitutions include: -# - %N name of widget loaded into the editor. +# - %N name of variable loaded into the editor. # - %I Index of the editor that invoked this. # - %W $win. +# -setcmd - Script that is invoked when the Set button is clicked. The following substitutions +# are supported: +# %N - name loaded into the editor. +# %V - Value loaded into the editor. +# %U - Units loaded into the editor. +# %I - Index of the selected editor. +# %W - Widget of the selected editor. +# -array - 0 if the array check button is off 1 otherwise. # # METHODS: # loadEditor - Loads the contents of a specific editor. @@ -62,6 +70,8 @@ option -current -default 1 option -selectcmd -default [list] option -loadcmd -default [list] + option -setcmd -default [list] + option -array -default 0 ## #Create/layout the widgets and set up the callbacks and bindings. @@ -77,7 +87,8 @@ ttk::label $win.name -text Name ttk::label $win.value -text Value ttk::label $win.units -text Units - ttk::checkbutton $win.array -offvalue 0 -onvalue 1 -text Array + ttk::checkbutton $win.array -offvalue 0 -onvalue 1 -text Array -variable \ + ${selfns}::options(-array) $self configurelist $args @@ -91,7 +102,7 @@ ttk::entry $win.value$row -width 10 ttk::entry $win.units$row -width 10 ttk::button $win.load$row -text Load -command [mymethod ReloadDispatch $row] - ttk::button $win.set$row -text Set + ttk::button $win.set$row -text Set -command [mymethod SetVariable $row] grid $win.radio$row $win.name$row $win.value$row $win.units$row $win.load$row $win.set$row } @@ -165,6 +176,18 @@ $self Dispatch $options(-loadcmd) [list %W %N %I] [list $win $name $row] } } + ## + # Dispatch the -setcmd script. See the header comments for the supported substitutions. + # @param index - Index of the editor that was involved. + # + method SetVariable index { + set name [$win.name$index get] + if {$name ne ""} { + set value [$win.value$index get] + set units [$win.units$index get] + $self Dispatch $options(-setcmd) [list %N %V %U %I %W] [list $name $value $units $index $win] + } + } #--------------------------------------------------------------------- # Private utilities. # Modified: trunk/SpecTcl/treegui/variableTabActions.tcl =================================================================== --- trunk/SpecTcl/treegui/variableTabActions.tcl 2011-12-12 20:22:29 UTC (rev 1931) +++ trunk/SpecTcl/treegui/variableTabActions.tcl 2011-12-12 21:49:50 UTC (rev 1932) @@ -31,24 +31,9 @@ public variable widget public variable lines 20 - #------------------------------------------------------------------ - # Private support functions. - ## - # Return a list of the tree variable names. - # @return list - # @retval list of tree variable names. - private method treeVariableNames {} { - set result [list] - foreach variable [treevariable -list] { - lappend result [lindex $variable 0] - } - - return $result - } - #------------------------------------------------------------------- # Callbacks (note these must be public to work @@ -67,7 +52,50 @@ } } + ## + # Set new tree variable specifications. + # @param name - Name of the tree variable. + # @param value - New value. + # @param units - New units. + # + method SetVariable {name value units} { + # Get the correct set of variables to modify depending o the state of the array checkbox. + if {[$widget cget -array]} { + + set names [::treeutility::listArrayElements $name [list $this treeVariableNames]] + } else { + set names [list $name] + + } + + # Loop over the names we need to process. + + foreach name $names { + + # The tree parameter must exist: + set definition [treevariable -list $name] + if {[llength $definition] != 0} { + treevariable -set $name $value $units + treevariable -firetraces $name + } + } + } + ## + # Return a list of the tree variable names. + # @return list + # @retval list of tree variable names. + + public method treeVariableNames {{pattern *}} { + set result [list] + + foreach variable [treevariable -list $pattern] { + lappend result [lindex $variable 0] + } + + return $result + } + #-------------------------------------------------------------------- # public interface @@ -84,7 +112,8 @@ treeVariableContainer $widget -lines $lines -selectcmd [list $this LoadVariable %N %I] \ -variables [$this treeVariableNames] \ - -loadcmd [list $this LoadVariable %N %I] + -loadcmd [list $this LoadVariable %N %I] \ + -setcmd [list $this SetVariable %N %V %U] } This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ro...@us...> - 2011-12-13 14:51:33
|
Revision: 1933 http://nsclspectcl.svn.sourceforge.net/nsclspectcl/?rev=1933&view=rev Author: ron-fox Date: 2011-12-13 14:51:22 +0000 (Tue, 13 Dec 2011) Log Message: ----------- Work item 121 - Add the load/save stip and fold it into the treevariable container. Modified Paths: -------------- trunk/SpecTcl/treegui/treeVariableContainer.tcl Added Paths: ----------- trunk/SpecTcl/treegui/treeVariableLoadSave.tcl Modified: trunk/SpecTcl/treegui/treeVariableContainer.tcl =================================================================== --- trunk/SpecTcl/treegui/treeVariableContainer.tcl 2011-12-12 21:49:50 UTC (rev 1932) +++ trunk/SpecTcl/treegui/treeVariableContainer.tcl 2011-12-13 14:51:22 UTC (rev 1933) @@ -17,6 +17,7 @@ package require Tk package require snit package require treeVariableEditor +package require treeVariableLoadSave package provide treeVariableContainer 1.0 @@ -41,6 +42,10 @@ delegate option -setcmd to editors delegate option -array to editors + delegate option -loadfile to loadsave as -loadcmd + delegate option -savefile to loadsave as -savecmd + delegate option -filename to loadsave + delegate method loadEditor to editors ## @@ -51,12 +56,13 @@ # constructor args { - install editors as treeVariableEditor $win.editors - + install editors as treeVariableEditor $win.editors + install loadsave as treeVariableLoadSave $win.loadsave $self configurelist $args - grid $win.editors + grid $win.editors -sticky ew + grid $win.loadsave -sticky ew } } Added: trunk/SpecTcl/treegui/treeVariableLoadSave.tcl =================================================================== --- trunk/SpecTcl/treegui/treeVariableLoadSave.tcl (rev 0) +++ trunk/SpecTcl/treegui/treeVariableLoadSave.tcl 2011-12-13 14:51:22 UTC (rev 1933) @@ -0,0 +1,153 @@ +# This software is Copyright by the Board of Trustees of Michigan +# State University (c) Copyright 2009. +# +# You may use this software under the terms of the GNU public license +# (GPL). The terms of this license are described at: +# +# http://www.gnu.org/licenses/gpl.txt +# +# Author: +# Ron Fox +# NSCL +# Michigan State University +# East Lansing, MI 48824-1321 + +package require Tk +package require snit + + +package provide treeVariableLoadSave 1.0 + +## +# Provides the snit megawiget that saves and restores +# tree parameters. The layout of the widget is as follows: +# +# -------------------------------------------------------------+ +# | [Load ] [Save] Current file: /path/to/last/file | +# +------------------------------------------------------------+ +# +# OPTIONS +# -filename - Full cannonicalized path to the most recent load/save file. +# -loadcmd - Script to process the load operation. %F is the path of the file +# selected by the user. The last file is the default. +# -savecmd - Script to process the save operation. %F is the path of the file +# selected by the user. The last file is the default. +# +snit::widget treeVariableLoadSave { + hulltype ttk::frame + + option -filename -default [list] + option -loadcmd -default [list] + option -savecmd -default [list] + + # File types for the file box prompts. We probably have two more + # than actually needed. + + typevariable fileTypes { + {{Tcl Scripts} {.tcl} } + {{Text files} {.txt} } + {{Tree variable files} {.tv} } + {{All Files} * } + } + + ## + # Construct the widgets, lay them out and connect them to our + # local action handlers. + # @param args - option/value pairs. + # + constructor args { + $self configurelist $args + + ttk::button $win.load -text "Load" -command [mymethod OnLoad] + ttk::button $win.save -text "Save" -command [mymethod OnSave] + ttk::label $win.cfile -text " Current File: " + ttk::label $win.filename -textvariable ${selfns}::options(-filename) -width 60 + + grid $win.load $win.save $win.cfile $win.filename + } + #----------------------------------------------------------------------------- + # Action handlers. + + ## + # Handle the Load button. We prompt for a filename using + # as a default directory the path and as a default name the name of the most recent + # file if it exists. Otherwise the cwd is used and there is no default filename. + # + method OnLoad {} { + + + # Figure out where and which file was last and make that the default. + + set defaults [$self GetDefaultFile] + + + # Prompt the user for the file. If it's empty the user cancelled: + + set filename [tk_getOpenFile -defaultextension .tcl -filetypes $fileTypes \ + -initialdir [lindex $defaults 0] \ + -initialfile [lindex $defaults 1] \ + -parent $win \ + -title "Select treevariable loadfile"] + + if {$filename ne ""} { + set options(-filename) $filename + $self Dispatch -loadcmd $filename + } + } + ## + # Handle the save button. Prompt for the filename as for OnLoad and + # dispatch to the user's script. + # + method OnSave {} { + # Figure out where and which file was last and make that the default. + + set defaults [$self GetDefaultFile] + + + # Prompt the user for the file. If it's empty the user cancelled: + + set filename [tk_getSaveFile -defaultextension .tcl -filetypes $fileTypes \ + -initialdir [lindex $defaults 0] \ + -initialfile [lindex $defaults 1] \ + -parent $win \ + -title "Select treevariable loadfile"] + + if {$filename ne ""} { + set options(-filename) $filename + $self Dispatch -savecmd $filename + } + } + #---------------------------------------------------------------------------- + # Local private methods: + + ## + # Return the current file and default file as a list. + # @return list + # @retval [list defaultdirectory defaultfilename] + # + method GetDefaultFile {} { + set defaultFile $options(-filename) + if {$defaultFile ne ""} { + set defaultDir [file dirname $defaultFile] + set defaultFile [file tail $defaultFile] + } else { + set defaultDir [pwd] + set defaultFile "" + } + return [list $defaultDir $defaultFile] + } + ## + # Dispatch one of the scripts: + # @param option - selects which script is being dispatched. + # @param filename - The filename which substitutes for any %F's. + # + method Dispatch {option filename} { + set script $options($option) + + if {$script ne ""} { + regsub -all -- {%F} $script $filename script + regsub -all -- {%W} $script $win script + uplevel #0 $script + } + } +} \ No newline at end of file This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ro...@us...> - 2011-12-13 18:34:06
|
Revision: 1937 http://nsclspectcl.svn.sourceforge.net/nsclspectcl/?rev=1937&view=rev Author: ron-fox Date: 2011-12-13 18:34:00 +0000 (Tue, 13 Dec 2011) Log Message: ----------- Work item 130 - factor out script dispatch into treeUtilities package. Modified Paths: -------------- trunk/SpecTcl/treegui/gateCreate.tcl trunk/SpecTcl/treegui/gateSelBar.tcl trunk/SpecTcl/treegui/gateTable.tcl trunk/SpecTcl/treegui/treeParameterWidget.tcl trunk/SpecTcl/treegui/treeParametersContainer.tcl trunk/SpecTcl/treegui/treeUtilities.tcl trunk/SpecTcl/treegui/treeVariableEditor.tcl trunk/SpecTcl/treegui/treeVariableLoadSave.tcl trunk/SpecTcl/treegui/treemenuWidget.tcl Modified: trunk/SpecTcl/treegui/gateCreate.tcl =================================================================== --- trunk/SpecTcl/treegui/gateCreate.tcl 2011-12-13 15:30:40 UTC (rev 1936) +++ trunk/SpecTcl/treegui/gateCreate.tcl 2011-12-13 18:34:00 UTC (rev 1937) @@ -17,6 +17,7 @@ package require Tk package require snit package require treemenuWidget +package require treeUtilities package provide gateCreate 1.0 @@ -144,18 +145,8 @@ # See the class header for information about the substitutions we support. # method Dispatch option { - set script $options($option) - - if {$script ne ""} { - - # Do the % substitutions: - - foreach pattern {%G %T %D} \ - value [list [list $options(-gatename)] [list $options(-type)] [list $options(-definition)]] { - regsub -all $pattern $script $value script - } - uplevel #0 $script - } + ::treeutility::dispatch $options($option) [list %G %T %D] \ + [list [list $options(-gatename)] [list $options(-type)] [list $options(-definition)]] } #------------------------------------------------------------------- Modified: trunk/SpecTcl/treegui/gateSelBar.tcl =================================================================== --- trunk/SpecTcl/treegui/gateSelBar.tcl 2011-12-13 15:30:40 UTC (rev 1936) +++ trunk/SpecTcl/treegui/gateSelBar.tcl 2011-12-13 18:34:00 UTC (rev 1937) @@ -16,6 +16,7 @@ package require Tk package require snit +package require treeUtilities package provide gateSelBar 1.0 @@ -95,13 +96,7 @@ # @param option The name of the option that holds the script we are dispatching. # method dispatch option { - set script $options($option) - - if {$script ne ""} { - - regsub "%M" $script [list [$win.mask get]] script - uplevel #0 $script - } + ::treeutility::dispatch $options($option) %M [list [list [$win.mask get]]] } ## # Called when the clear button is clicked. Clears the mask back to "*" and Modified: trunk/SpecTcl/treegui/gateTable.tcl =================================================================== --- trunk/SpecTcl/treegui/gateTable.tcl 2011-12-13 15:30:40 UTC (rev 1936) +++ trunk/SpecTcl/treegui/gateTable.tcl 2011-12-13 18:34:00 UTC (rev 1937) @@ -16,6 +16,7 @@ package require Tk package require snit +package require treeUtilities package provide gateTable 1.0 @@ -187,18 +188,15 @@ # @param y - window relative y positinoof the click. # method onDoubleClick {x y} { - set script $options(-command) - if {$script ne ""} { - set item [$win.t identify row $x $y] - if {$item ne ""} { - set data [$win.t item $item -values] - set name [lindex $data 0] - - regsub "%N" $script $name script - uplevel #0 $script - } + set item [$win.t identify row $x $y] + if {$item ne ""} { + set data [$win.t item $item -values] + set name [lindex $data 0] + + ::treeutility::dispatch $options(-command) %N $name } + } Modified: trunk/SpecTcl/treegui/treeParameterWidget.tcl =================================================================== --- trunk/SpecTcl/treegui/treeParameterWidget.tcl 2011-12-13 15:30:40 UTC (rev 1936) +++ trunk/SpecTcl/treegui/treeParameterWidget.tcl 2011-12-13 18:34:00 UTC (rev 1937) @@ -16,6 +16,7 @@ package require Tk package require snit +package require treeUtilities package provide treeParameterEditor 1.0 @@ -137,17 +138,7 @@ # @param optionName -name of the option holding the script to execute. # method callback optionName { - set script $options($optionName) - - # empty scripts are no-ops. - - if {$script ne ""} { - - # Substitute for %W: - - regsub -all {%W} $script $win script - uplevel #0 $script - } + ::treeutility::dispatch $options($optionName) %W $win } ## Modified: trunk/SpecTcl/treegui/treeParametersContainer.tcl =================================================================== --- trunk/SpecTcl/treegui/treeParametersContainer.tcl 2011-12-13 15:30:40 UTC (rev 1936) +++ trunk/SpecTcl/treegui/treeParametersContainer.tcl 2011-12-13 18:34:00 UTC (rev 1937) @@ -16,6 +16,7 @@ package require snit package require treemenuWidget package require treeParameterEditor +package require treeUtilities package provide treeParametersContainer 1.0 @@ -227,15 +228,8 @@ # @param path - Full path to menu label. # method ParameterChosen {widget label path} { - set script $options(-choosecmd) + ::treeutility::dispatch $options(-choosecmd) [list %W %I %L %N] [list $win $widget $label $path] - # Only dispatch if, in fact, there is a nonempty script - - if {$script ne ""} { - - set script [Substitute $script [list %W %I %L %N] [list $win $widget $label $path]] - uplevel #0 $script - } } ## @@ -249,31 +243,8 @@ # @param option that has the script to which we must dispatch: # method ButtonClicked {editor slot option} { - set script $options($option) - - if {$script ne ""} { - set script [Substitute $script [list %W %S %I] [list $win $slot $editor]] - uplevel #0 $script - } + ::treeutility::dispatch $options($option) [list %W %S %I] [list $win $slot $editor] } - # Utiltity procs: - - ## - # Substitute a bunch of strings with a bunch of other stuff. - # @param in - The string in which substitutions will be done. - # @param patterns - The regexp patterns that will be substituted. - # @param subs - The substrings that will be subtstituted. - # @return string - # @retval The string with all substitutions performed. - # - proc Substitute {in patterns subs} { - foreach pattern $patterns replacement $subs { - # The [list] below ensure proper quoting of the replacement string: - regsub -all $pattern $in [list $replacement] in - } - return $in - } - } \ No newline at end of file Modified: trunk/SpecTcl/treegui/treeUtilities.tcl =================================================================== --- trunk/SpecTcl/treegui/treeUtilities.tcl 2011-12-13 15:30:40 UTC (rev 1936) +++ trunk/SpecTcl/treegui/treeUtilities.tcl 2011-12-13 18:34:00 UTC (rev 1937) @@ -52,4 +52,25 @@ } } return $result +} +## +# Dispatch to a script with substitutions. +# @param script - The script to dispatch. +# @param substs - list of substitution patterns. These are treated as regexps. +# @param values - List of corresponding values to substitute for each match. +# +# @note - the script is run at the global level. +# +proc ::treeutility::dispatch {script substs values} { + if {$script ne ""} { + + # Do the substitutions: + + foreach pattern $substs value $values { + regsub -all -- $pattern $script $value script + } + # Run the resulting script script: + + uplevel #0 $script + } } \ No newline at end of file Modified: trunk/SpecTcl/treegui/treeVariableEditor.tcl =================================================================== --- trunk/SpecTcl/treegui/treeVariableEditor.tcl 2011-12-13 15:30:40 UTC (rev 1936) +++ trunk/SpecTcl/treegui/treeVariableEditor.tcl 2011-12-13 18:34:00 UTC (rev 1937) @@ -17,6 +17,7 @@ package require Tk package require snit package require treemenuWidget +package require treeUtilities package provide treeVariableEditor 1.0 @@ -221,12 +222,7 @@ # @pram values - For each element of substs a value that can be plugged into the script # method Dispatch {script substs values} { - if {$script ne ""} { - foreach subst $substs value $values { - regsub -all $subst $script $value script - } - uplevel #0 $script - } + ::treeutility::dispatch $script $substs $values } } \ No newline at end of file Modified: trunk/SpecTcl/treegui/treeVariableLoadSave.tcl =================================================================== --- trunk/SpecTcl/treegui/treeVariableLoadSave.tcl 2011-12-13 15:30:40 UTC (rev 1936) +++ trunk/SpecTcl/treegui/treeVariableLoadSave.tcl 2011-12-13 18:34:00 UTC (rev 1937) @@ -14,8 +14,8 @@ package require Tk package require snit +package require treeUtilities - package provide treeVariableLoadSave 1.0 ## @@ -142,12 +142,6 @@ # @param filename - The filename which substitutes for any %F's. # method Dispatch {option filename} { - set script $options($option) - - if {$script ne ""} { - regsub -all -- {%F} $script $filename script - regsub -all -- {%W} $script $win script - uplevel #0 $script - } + ::treeutility::dispatch $options($option) [list %F %W] [list $filename $win] } } \ No newline at end of file Modified: trunk/SpecTcl/treegui/treemenuWidget.tcl =================================================================== --- trunk/SpecTcl/treegui/treemenuWidget.tcl 2011-12-13 15:30:40 UTC (rev 1936) +++ trunk/SpecTcl/treegui/treemenuWidget.tcl 2011-12-13 18:34:00 UTC (rev 1937) @@ -15,6 +15,7 @@ package require Tk package require snit +package require treeUtilities package provide treemenuWidget 1.0 @@ -76,24 +77,8 @@ # the elements of the path list with -splitchar. # method dispatch {label path} { - set script $options(-command) + ::treeutility::dispatch $options(-command) [list %W %L %N] [list $win [list $label] [list $path]] - - - # Only bother if the user supplied a -command - - if {$script ne ""} { - - # Do the %xyz substitutions: - - foreach substring [list %W %L %N] replstring [list $win [list $label] [list $path]] { - regsub -all $substring $script $replstring script - } - - # Execute the resulting script at global level. - - uplevel #0 $script - } } ## # private method, this is a recursive proc that builds the menu hierarchy. This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ro...@us...> - 2011-12-14 15:25:41
|
Revision: 1939 http://nsclspectcl.svn.sourceforge.net/nsclspectcl/?rev=1939&view=rev Author: ron-fox Date: 2011-12-14 15:25:35 +0000 (Wed, 14 Dec 2011) Log Message: ----------- mcgui replacement spectrum tab load/save now working Modified Paths: -------------- trunk/SpecTcl/treegui/treeUtilities.tcl trunk/SpecTcl/treegui/treeVariableLoadSave.tcl Added Paths: ----------- trunk/SpecTcl/treegui/definitionFile.tcl trunk/SpecTcl/treegui/spectrumContainer.tcl trunk/SpecTcl/treegui/spectrumTabActions.tcl Added: trunk/SpecTcl/treegui/definitionFile.tcl =================================================================== --- trunk/SpecTcl/treegui/definitionFile.tcl (rev 0) +++ trunk/SpecTcl/treegui/definitionFile.tcl 2011-12-14 15:25:35 UTC (rev 1939) @@ -0,0 +1,190 @@ +# This software is Copyright by the Board of Trustees of Michigan +# State University (c) Copyright 2009. +# +# You may use this software under the terms of the GNU public license +# (GPL). The terms of this license are described at: +# +# http://www.gnu.org/licenses/gpl.txt +# +# Author: +# Ron Fox +# NSCL +# Michigan State University +# East Lansing, MI 48824-1321 + +package require Tk +package require snit +package require treeUtilities + +package provide definitionFileWidget 1.0 + +## +# Provides an interface for loading definition files. The layout of this widget is: +# +# +--------------------------------------+ +# | Definition file: | +# | <current def file label> | +# | [Load] [Save] | +# | [] Cumulate [] Failsafe | +# +--------------------------------------+ +# +# OPTIONS: +# -filename - The contents of the <current def file label> field +# -accumulate - The state of the Cumulate checkbutton. +# -makefailsafe - The state of the Failsafe checkbutton. +# -loadcmd - Script that is called when the Load button is clicked. +# -savecmd - Script that is called whenthe Save button is clicked. +# +# SUBSTITUTIONS: +# Callbacks support the following susbitutions: +# +# - %W - The widget name. +# - %N - The filename chosen by the user. +# +snit::widget definitionFileWidget { + hulltype ttk::frame + + option -filename -default Unknown -configuremethod SetFilename + option -accumulate -default 0 + option -makefailsafe -default 1 + option -loadcmd -default [list] + option -savecmd -default [list] + + + ## + # Construct the widget. + # @args - option name/values for the initial configuration. + # + constructor args { + + # Create the component widgets... + + ttk::label $win.fnamelabel -text {Definition file:} -justify center + ttk::label $win.filename -text Unknown -width 20 -justify center + + ttk::button $win.load -text Load -command [mymethod DispatchLoad] + ttk::button $win.save -text Save -command [mymethod DispatchSave] + + ttk::checkbutton $win.accumulate -text Cumulate \ + -onvalue 1 -offvalue 0 \ + -variable ${selfns}::options(-accumulate) + + ttk::checkbutton $win.failsafe -text Failsafe \ + -onvalue 1 -offvalue 0 \ + -variable ${selfns}::options(-makefailsafe) + + # Lay them out on the frame: + + grid $win.fnamelabel -columnspan 2 + grid $win.filename -columnspan 2 + grid $win.load $win.save + grid $win.accumulate $win.failsafe + + # configure the widget components: + + $self configurelist $args + + } + #----------------------------------------------------------------------- + # Configuration management. + + ## + # Configure -filename If the filename is longer than the width of the' + # widget, the last width-3 characters are put in the widget preceded by ellipsis. + # @param option - the option to modify (-filename) + # @param value - The new value of the option. + + method SetFilename {option value} { + set options($option) $value + + set maxWidth [$win.filename cget -width] + + if {[string length $value] > $maxWidth} { + set maxWidth [expr {$maxWidth - 3}] + set value ...[string range $value end-$maxWidth end] + } + $win.filename configure -text $value + } + #---------------------------------------------------------------------- + # Action handlers for the user interface. + + ## + # Handle the Save button. This dispatches to the -savecmd after first + # prompting for a filename. If no filename is given no callback is + # performed. If no script is registered nothing happens as well. + # We configure ourself with a new -filename if the callback runs as well. + # + method DispatchSave {} { + set script $options(-savecmd) + + if {$script ne ""} { + set filename [tk_getSaveFile \ + -defaultextension .tcl \ + -filetypes [::treeutility::getFileTypes] \ + -initialfile [$self GetDefaultFile] \ + -initialdir [$self GetDefaultDir] \ + -parent $win \ + -title "Select Save filename"] + if {$filename ne ""} { + ::treeutility::dispatch $script [list %W %N] [list $win $filename] + $self configure -filename $filename + } + } + } + + ## + # Handle the Load button. This dispatches to the -loadcmd after first + # prompting for a filename. If no filename is given or if there is no + # script no callback is performed. We configure ourselves with a new -filename + # if the callback runs. + # + method DispatchLoad {} { + set script $options(-loadcmd) + + if {$script ne ""} { + set filename [tk_getOpenFile \ + -defaultextension .tcl \ + -filetypes [::treeutility::getFileTypes] \ + -initialfile [$self GetDefaultFile] \ + -initialdir [$self GetDefaultDir] \ + -parent $win \ + -title "Select Save filename"] + if {$filename ne ""} { + ::treeutility::dispatch $script [list %W %N] [list $win $filename] + $self configure -filename $filename + } + } + } + #------------------------------------------------------------------------ + # Private utilities: + + ## + # Return the correct default file. This is either the tail of the -filename + # option value or "" if the -filename is 'Unknown' + # + method GetDefaultFile {} { + set filename $options(-filename) + + if {$filename eq "Unknown"} { + set default "" + } else { + set default [file tail $filename] + } + return $default + } + ## + # Return the correct default directory. This is either the dirname of -filename or + # [pwd] if that is 'Unknown'. + # + method GetDefaultDir {} { + set filename $options(-filename) + + if {$filename eq "Unknown"} { + set default [pwd] + } else { + set default [file dirname $filename] + } + return $default + } + +} \ No newline at end of file Added: trunk/SpecTcl/treegui/spectrumContainer.tcl =================================================================== --- trunk/SpecTcl/treegui/spectrumContainer.tcl (rev 0) +++ trunk/SpecTcl/treegui/spectrumContainer.tcl 2011-12-14 15:25:35 UTC (rev 1939) @@ -0,0 +1,58 @@ +# This software is Copyright by the Board of Trustees of Michigan +# State University (c) Copyright 2009. +# +# You may use this software under the terms of the GNU public license +# (GPL). The terms of this license are described at: +# +# http://www.gnu.org/licenses/gpl.txt +# +# Author: +# Ron Fox +# NSCL +# Michigan State University +# East Lansing, MI 48824-1321 + +package require Tk +package require snit +package require definitionFileWidget + +package provide spectrumContainer 1.0 + +## +# Provides the container for the entire +# spectrum maniuplation tab. This is a megawidget that is laid out as follows: +# +# +--------------------------------------------------------------------+ +# | spectrumType widget | definitionFile Widget | +# +--------------------------------------------------------------------+ +# +# OPTIONS: +# All options for all components are exposed as is unless otherwise noted. +# +# METHODS: +# All public component methods are exposed as is unless otherwise noted. +# + +snit::widget spectrumContainer { + hulltype ttk::frame + + # definitionFileWidget options: + + delegate option -filename to fileio + delegate option -accumulate to fileio + delegate option -makefailsafe to fileio + delegate option -loadcmd to fileio + delegate option -savecmd to fileio + + ## + # Construction is just installing and laying out the components. + # + # @param args - configuration option/names. + # + constructor args { + install fileio using definitionFileWidget $win.fileio + grid $win.fileio + + $self configurelist $args + } +} Added: trunk/SpecTcl/treegui/spectrumTabActions.tcl =================================================================== --- trunk/SpecTcl/treegui/spectrumTabActions.tcl (rev 0) +++ trunk/SpecTcl/treegui/spectrumTabActions.tcl 2011-12-14 15:25:35 UTC (rev 1939) @@ -0,0 +1,105 @@ +# This software is Copyright by the Board of Trustees of Michigan +# State University (c) Copyright 2009. +# +# You may use this software under the terms of the GNU public license +# (GPL). The terms of this license are described at: +# +# http://www.gnu.org/licenses/gpl.txt +# +# Author: +# Ron Fox +# NSCL +# Michigan State University +# East Lansing, MI 48824-1321 + +package require Tk +package require Itcl + +package require spectrumContainer +package require guistate + +package provide spectrumTabActions 1.0 + + +## +# Class to supply the actions for the spectrum tab. +# + +itcl::class spectrumTabActions { + public variable widget; # spectrumContainer widget option. + + #-------------------------------------------------------------------------- + # Call back methods. These are, by necesity public thought not really part of + # the public interface. + # + + ## + # Save the configuration + # @param file - name of the file to save it to. + # + public method SaveConfiguration {file} { + set fd [open $file w] + + # MC Gui does not emit spectrum deletes.... + + set prior $::guistate::writeDeletes + set ::guistate::writeDeletes 0 + + # write the definition file. + + writeAll $fd + close $fd + + # Restore the write deletes flag back to what it was. + + set ::guistate::writeDeletes $prior + + + } + ## + # Read the configuration the 'cumulate' sic checkbutton is used to determine + # if the current defintions are wiped out first. + # @param name - filename from which the configuration is loaded. + # @param widget - the defintionFile widget (has the -accumulate option we can query) + # that triggered this. + # + public method ReadConfiguration {name widget} { + set noclear [$widget cget -accumulate] + + # If noclear is not set we need to destroy the spectra as redefinition + # is an error: + + if {!$noclear} { + set spectra [spectrum -list] + foreach spectrum $spectra { + set sname [lindex $spectrum 1] + spectrum -delete $sname + } + } + # Now we can read the file: + # + uplevel #0 source $name + + + } + #--------------------------------------------------------------------------- + # True public interface. There are other public methods but they + # require that exposure to be used as callbacks. + # + + ## + # Construct the object and view: + # @paramargs - option/value pairs.. -widget is required. + # + constructor args { + configure {*}$args + + if {$widget eq ""} { + error "The -widget option is mandatory" + } + + spectrumContainer $widget \ + -savecmd [list $this SaveConfiguration %N] \ + -loadcmd [list $this ReadConfiguration %N %W] + } +} \ No newline at end of file Modified: trunk/SpecTcl/treegui/treeUtilities.tcl =================================================================== --- trunk/SpecTcl/treegui/treeUtilities.tcl 2011-12-13 18:55:43 UTC (rev 1938) +++ trunk/SpecTcl/treegui/treeUtilities.tcl 2011-12-14 15:25:35 UTC (rev 1939) @@ -73,4 +73,19 @@ uplevel #0 $script } -} \ No newline at end of file +} + +## +# Return the file types used for configuration file dialogs: +# @return list +# @retval see the tk_getOpenfile/tk_getSaveFile documents to see the format of this. +# +proc ::treeutility::getFileTypes {} { + return { + {{Tcl Scripts} {.tcl} } + {{Text files} {.txt} } + {{Tree variable files} {.tv} } + {{All Files} * } + } +} + Modified: trunk/SpecTcl/treegui/treeVariableLoadSave.tcl =================================================================== --- trunk/SpecTcl/treegui/treeVariableLoadSave.tcl 2011-12-13 18:55:43 UTC (rev 1938) +++ trunk/SpecTcl/treegui/treeVariableLoadSave.tcl 2011-12-14 15:25:35 UTC (rev 1939) @@ -40,16 +40,6 @@ option -loadcmd -default [list] option -savecmd -default [list] - # File types for the file box prompts. We probably have two more - # than actually needed. - - typevariable fileTypes { - {{Tcl Scripts} {.tcl} } - {{Text files} {.txt} } - {{Tree variable files} {.tv} } - {{All Files} * } - } - ## # Construct the widgets, lay them out and connect them to our # local action handlers. @@ -83,7 +73,8 @@ # Prompt the user for the file. If it's empty the user cancelled: - set filename [tk_getOpenFile -defaultextension .tcl -filetypes $fileTypes \ + set filename [tk_getOpenFile -defaultextension .tcl \ + -filetypes [::treeutility::getFileTypes] \ -initialdir [lindex $defaults 0] \ -initialfile [lindex $defaults 1] \ -parent $win \ @@ -106,7 +97,8 @@ # Prompt the user for the file. If it's empty the user cancelled: - set filename [tk_getSaveFile -defaultextension .tcl -filetypes $fileTypes \ + set filename [tk_getSaveFile -defaultextension .tcl \ + -filetypes [::treeutility::getFileTypes] \ -initialdir [lindex $defaults 0] \ -initialfile [lindex $defaults 1] \ -parent $win \ This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ro...@us...> - 2011-12-14 21:40:45
|
Revision: 1940 http://nsclspectcl.svn.sourceforge.net/nsclspectcl/?rev=1940&view=rev Author: ron-fox Date: 2011-12-14 21:40:38 +0000 (Wed, 14 Dec 2011) Log Message: ----------- essage=Completed work item 26 - Got spectrum listing widget working..hooked in Modified Paths: -------------- trunk/SpecTcl/treegui/definitionFile.tcl trunk/SpecTcl/treegui/gateTable.tcl trunk/SpecTcl/treegui/spectrumContainer.tcl trunk/SpecTcl/treegui/spectrumTabActions.tcl Added Paths: ----------- trunk/SpecTcl/treegui/spectrumMask.tcl trunk/SpecTcl/treegui/spectrumTable.tcl Modified: trunk/SpecTcl/treegui/definitionFile.tcl =================================================================== --- trunk/SpecTcl/treegui/definitionFile.tcl 2011-12-14 15:25:35 UTC (rev 1939) +++ trunk/SpecTcl/treegui/definitionFile.tcl 2011-12-14 21:40:38 UTC (rev 1940) @@ -80,6 +80,8 @@ grid $win.load $win.save grid $win.accumulate $win.failsafe + grid columnconfigure $win all -weight 1 + # configure the widget components: $self configurelist $args Modified: trunk/SpecTcl/treegui/gateTable.tcl =================================================================== --- trunk/SpecTcl/treegui/gateTable.tcl 2011-12-14 15:25:35 UTC (rev 1939) +++ trunk/SpecTcl/treegui/gateTable.tcl 2011-12-14 21:40:38 UTC (rev 1940) @@ -20,7 +20,7 @@ package provide gateTable 1.0 -namespace eval gateTable:: { +namespace eval ::gateTable { set dirname [file dirname [info script]] } @@ -60,18 +60,18 @@ delegate option * to tree delegate method * to tree + + #Images used to label the column sort order + + typevariable uparrow + typevariable downarrow + # This variable is an array that maps field names to gate indices: - typevariable fieldMap -array { - name 0 - type 2 - definition 3 - } - typevariable sortMap -array { - ascending -increasing - descending -decreasing - } + typevariable fieldMap + typevariable sortMap + # Several options can schedule a repopulation of the tree. # Rather than do all of those operations, updates are scheduled # and this variable is non-zero if an upate is already scheduled. @@ -79,28 +79,19 @@ variable updatePending 0; # True if an update has been scheduled. - #Images used to label the column sort order - variable uparrow - variable downarrow - # Variables used to keep track of mouse motion. # variable lastX 0 variable lastY 0 variable lastItem [list] + #----------------------------------------------------------------------------- + # Constructors. - - - ## - # Build the widget, and establish the bindings that lead to - # callbacks and internally autonomous behavior. + # Load the up/down arrow images: # - # @param args - option name value pairs that configure the widget. - - constructor args { - + typeconstructor { set dirname $gateTable::dirname puts $dirname @@ -116,7 +107,29 @@ $downarrow copy $img -subsample 40 40 image delete $img + array set fieldMap { + name 0 + type 2 + definition 3 + } + array set sortMap { + ascending -increasing + descending -decreasing + } + } + + ## + # Build the widget, and establish the bindings that lead to + # callbacks and internally autonomous behavior. + # + # @param args - option name value pairs that configure the widget. + + constructor args { + + + + # Build the widgets. set headings [list Name Type Definition] install tree using ttk::treeview $win.t -columns $headings -selectmode extended -show headings \ Modified: trunk/SpecTcl/treegui/spectrumContainer.tcl =================================================================== --- trunk/SpecTcl/treegui/spectrumContainer.tcl 2011-12-14 15:25:35 UTC (rev 1939) +++ trunk/SpecTcl/treegui/spectrumContainer.tcl 2011-12-14 21:40:38 UTC (rev 1940) @@ -15,6 +15,8 @@ package require Tk package require snit package require definitionFileWidget +package require spectrumMaskWidget +package require spectrumTable package provide spectrumContainer 1.0 @@ -44,6 +46,16 @@ delegate option -loadcmd to fileio delegate option -savecmd to fileio + # Spectrum mask options: + + delegate option -mask to mask + delegate option -updatecmd to mask + + # Spectrum table optinos. + + delegate option -spectra to table + delegate option -selectcmd to table + ## # Construction is just installing and laying out the components. # @@ -51,8 +63,17 @@ # constructor args { install fileio using definitionFileWidget $win.fileio - grid $win.fileio + install table using spectrumTable $win.table -height 15 + install mask using spectrumMaskWidget $win.mask + + grid $fileio -sticky ew + grid $table -sticky ew + grid $mask -sticky ew + + grid columnconfigure $win all -weight 1 + $self configurelist $args + } } Added: trunk/SpecTcl/treegui/spectrumMask.tcl =================================================================== --- trunk/SpecTcl/treegui/spectrumMask.tcl (rev 0) +++ trunk/SpecTcl/treegui/spectrumMask.tcl 2011-12-14 21:40:38 UTC (rev 1940) @@ -0,0 +1,102 @@ +# This software is Copyright by the Board of Trustees of Michigan +# State University (c) Copyright 2009. +# +# You may use this software under the terms of the GNU public license +# (GPL). The terms of this license are described at: +# +# http://www.gnu.org/licenses/gpl.txt +# +# Author: +# Ron Fox +# NSCL +# Michigan State University +# East Lansing, MI 48824-1321 + +package require Tk +package require snit +package require treeUtilities + +package provide spectrumMaskWidget 1.0 + +## +# Provides a GUI that allows users to select the specific subset of spetra +# they are interested in via a Glob pattern. +# Format of the widget is: +# +# +-------------------------------------------------------------+ +# | [Update spectrum list] Spectrum Mask>: <mask entry> [Clear] | +# +-------------------------------------------------------------+ +# +# OPTIONS: +# -mask - set/get the mask entry value. +# -updatecmd - Script to invoke when the mask has been updated. +# +# SUBSTITUTIONS: +# %M - The current mask value. +# %W - The widget name. +# +# AUTONOMOUS ACTIONS: +# If the Clear button is clicked, the mask entry is modified to * +# which implies that -updatecmd is invoked. +# +# NOTE: +# Key bindings are used to drive the callback as otherwise validation (the other option) is +# a prevalidation making it just too hard to figure out the current value of entry. +# + +snit::widget spectrumMaskWidget { + hulltype ttk::frame + + option -mask -default * -configuremethod SetMask + option -updatecmd -default [list] + + ## + # Create/layout the widget components and setup the events/bindings. + # @param args -option/values for the initial configuration. + # + constructor args { + + ttk::button $win.update -text {Update Spectrum List} -command [mymethod Dispatch -updatecmd] + ttk::label $win.masklbl -text { Spectrum Mask: } + ttk::entry $win.mask -width 20 -textvariable ${selfns}::options(-mask) + ttk::button $win.clear -text Clear -command [mymethod SetMask -mask *] + + bind $win.mask <KeyRelease> [mymethod Dispatch -updatecmd] + + $self configurelist $args; # Done now so that -mask configuration triggers the update. + + grid $win.update $win.masklbl $win.mask $win.clear + grid columnconfigure $win all -weight 1 + + + } + #----------------------------------------------------------------------------------- + # Configuration management. + + ## + # Handle the -mask configuration. This: + # - Saves the mask in options(-mask) + # - Rewrites the contents of the mask entry + # - Dispatches to the -updatecmd handler script. + # + # @param option - option name (should be -mask). + # @param value - New value of the -mask option. + # + method SetMask {option value} { + set options($option) $value; # Also updates the value of the entry. + + $self Dispatch -updatecmd; # Mask has changed so let the client know about it. + } + + #----------------------------------------------------------------------------------- + # Action handlers. + + ## + # Dispatch to a user script substitutions supported include %W (the widget) %M (mask value) + # @param option - option containing the script to which we dispatch. + # + method Dispatch option { + treeutility::dispatch $options($option) [list %W %M] [list $win $options(-mask)] + } + +} \ No newline at end of file Modified: trunk/SpecTcl/treegui/spectrumTabActions.tcl =================================================================== --- trunk/SpecTcl/treegui/spectrumTabActions.tcl 2011-12-14 15:25:35 UTC (rev 1939) +++ trunk/SpecTcl/treegui/spectrumTabActions.tcl 2011-12-14 21:40:38 UTC (rev 1940) @@ -82,6 +82,56 @@ } + ## + # Load the list of spectra from the current mask + # @param mask - glob pattern that determines the set of spectra to load. + # + public method LoadSpectra mask { + set spectra [spectrum -list -showgate $mask] + set spectrumList [list]; # Build up the data here: + + # Pull each definition apart and add it to spectrumList. + + foreach spectrum $spectra { + set name [lindex $spectrum 1] + set type [lindex $spectrum 2] + set parameters [lindex $spectrum 3] + set axes [lindex $spectrum 4] + set gate [lindex $spectrum 6] + + # Ungated true gate -> "" + if {$gate eq "-TRUE-"} { + set gate "" + } + + set xparam [lindex [lindex $parameters 0] 0] + set yparam [lindex [lindex $parameters 1] 0] + + set xaxis [lindex $axes 0] + set xlow [lindex $xaxis 0] + set xhi [lindex $xaxis 1] + set xbins [lindex $xaxis 2] + + set yaxis [lindex $axes 1] + if {[llength $yaxis] > 0} { + set ylow [lindex $yaxis 0] + set yhi [lindex $yaxis 1] + set ybins [lindex $yaxis 2] + + } else { + set ylow "" + set yhi "" + set ybins "" + } + + lappend spectrumList [list $name $type \ + $xparam $xlow $xhi $xbins \ + $yparam $ylow $yhi $ybins \ + $gate] + + } + $widget configure -spectra $spectrumList + } #--------------------------------------------------------------------------- # True public interface. There are other public methods but they # require that exposure to be used as callbacks. @@ -100,6 +150,9 @@ spectrumContainer $widget \ -savecmd [list $this SaveConfiguration %N] \ - -loadcmd [list $this ReadConfiguration %N %W] + -loadcmd [list $this ReadConfiguration %N %W] \ + -updatecmd [list $this LoadSpectra %M] + + LoadSpectra [$widget cget -mask] } } \ No newline at end of file Added: trunk/SpecTcl/treegui/spectrumTable.tcl =================================================================== --- trunk/SpecTcl/treegui/spectrumTable.tcl (rev 0) +++ trunk/SpecTcl/treegui/spectrumTable.tcl 2011-12-14 21:40:38 UTC (rev 1940) @@ -0,0 +1,401 @@ +# This software is Copyright by the Board of Trustees of Michigan +# State University (c) Copyright 2009. +# +# You may use this software under the terms of the GNU public license +# (GPL). The terms of this license are described at: +# +# http://www.gnu.org/licenses/gpl.txt +# +# Author: +# Ron Fox +# NSCL +# Michigan State University +# East Lansing, MI 48824-1321 + + + +package require Tk +package require snit +package require treeUtilities + +package provide spectrumTable 1.0 + +# +# The following code is needed to establish our location in the file system +# specifically so that we can, in turn locate the sorting arrow widgets. +# This cannot be done in the constructor as there [info script] returns the +# script that is invoking the constructor and that could be elsewhere +# (trust me I've tried that and been burned). + +namespace eval ::spectrumTable { + set dirname [file dirname [info script]] +} + +## +# Provides a table that lists Spectrum information. +# for each spectrum there are columns for name, type, x parameter name, X parameter low, high limits +# and binning and same information for a Y parameter. Finally there is a column for the applied gate. +# +# OPTIONS: +# -spectra - supplies/gets the set of spectrum definitions that are being displayed. +# This is a Tcl list of one element per spectrum. The elements are themselves +# lists with elements that contain in order +# spectrum-name, type, X parameter, Xlow, Xhi, Xbins, Yparameter, YLow, Yhigh, Bins, +# Applied Gate. +# -selectcmd - Script that is invoked when a spectrum is double-clicked. %W can be translated +# to the widget name, %N the name of the spectrum clicked on. +# METHODS: +# getSelection - gets a list of the names of spectra that are in the selection. +# +# BINDINGS: +# - clicking on a column selects the column to be sorted in ascendnig order. If the column +# is already selected, the sort order is reversed. +# - B1-Motion drags the selection endpoint. The other selection operations <Control-B1> +# <Shift-B1> are implemented by the underlying tree widget as it is run with +# -selectmode extended +# - Double clicking an item fires the -selectcmd callback if defined. +# + +snit::widget spectrumTable { + hulltype ttk::frame + + option -spectra -default [list] -configuremethod SetSpectra + option -selectcmd -default [list] + + # + # Let the user configure the tree: + # + + delegate option * to tree + delegate method * to tree + + # + # Several things can schedule an update. Rather than do all operations, updates are scheduled + # and any updates that might happen while the scheduled update is pending don't cause any additional + # updates. This hopefully reduces the set of updates required. + # + + variable updatePending 0; # non zero if an update is scheduled. + + typevariable updateScheduleTime + + # Sort icon images. + + typevariable uparrow + typevariable downarrow + typevariable sortDirectionImage + typevariable resampleFactor + + # Map the sort direction to an arrow: + + + # Column information: + + typevariable headings + typevariable titles + typevariable widths + + + # Variables used to keep track of mouse motion for stretching/shrinking the selection. + + variable lastX + variable lastY + variable lastItem [list] + + variable sortColumn Name + variable sortDirection -increasing + + + #------------------------------------------------------------------------------ + # Constructors: + + ## + # Initialize the type variables. + # + typeconstructor { + + set updateScheduleTime 2 + set resampleFactor 40 + + set dirname $spectrumTable::dirname + puts $dirname + + set img [image create photo \ + -file [file join $dirname uparrow.gif]] + set uparrow [image create photo] + $uparrow copy $img -subsample $resampleFactor $resampleFactor + image delete $img + + set img [image create photo \ + -file [file join $dirname downarrow.gif]] + set downarrow [image create photo] + $downarrow copy $img -subsample $resampleFactor $resampleFactor + image delete $img + + array set sortDirectionImage [list -increasing $uparrow -decreasing $downarrow] + + + set headings [list Name Type Xname Xlow Xhigh Xbins Yname Ylow Yhigh Ybins Gate] + set titles [list Name Type "X Parameter" Low High Bins "Y Parameter" Low High Bins Gate] + set widths [list 175 35 100 30 30 30 100 30 30 30 75] + + } + + ## + # Construct the widget, lay it out and attache event/bindings handlers. + # @args - option/values that configure the intial state of the megawiget. + # + constructor args { + # In this case the headings names differ somewhat from their titles so that + # the headings names can be unique. + # + + # Install the treeview (tree) component and configure the underlying tree: + + install tree using ttk::treeview $win.t -columns $headings -selectmode extended -show headings \ + -yscrollcommand [list $win.s set] + + + foreach column $headings title $titles width $widths { + $tree heading $column -text $title -command [mymethod ChangeSort $column] -anchor w + $tree column $column -width $width -anchor w -stretch 1 + } + $tree heading Name -image $uparrow; # Initial sort is ascending on the name column. + + # Add the scrollbar in case the number of spectra make it worthwhile: + + scrollbar $win.s -command [list $win.t yview] + + + # Now we can confgure and make visible: + + $self configurelist $args + grid $tree $win.s -sticky nsew + grid columnconfigure $win all -weight 1 + + # Event bindings: + + bind $tree <Double-1> [mymethod OnDoubleClick %x %y] + bind $tree <ButtonPress-1> [mymethod StartDrag %x %y] + bind $tree <B1-Motion> [mymethod DragTo %x %y] + + } + #------------------------------------------------------------------ + # + # Public methods: + + ## + # Return the names of the selected spectra. + # @return list + # @retval Possibly empty list consisting of the names of the selected spectra. + # + method getSelection {} { + set result [list] + set items [$tree selection] + foreach item $items { + lappend result [lindex [$tree item $item -values] 0] + } + return $result + } + #------------------------------------------------------------------ + # Event and bindings handlers. + + ## + # Handle double clicks on a specific element. Identifies the name of + # the spectrum and passes control to the -selectcmd callback + # @param x,y - widget relative coordinates of the event. + # + method OnDoubleClick {x y} { + set item [$tree identify row $x $y] + if {$item ne ""} { + set data [$tree item $item -values] + set name [lindex $data 0] + + + + ::treeutility::dispatch $options(-selectcmd) [list %W %N] [list $win $name] + } + } + ## + # Invoked when a column header is clicked. This changes the sort field and potentially + # the order if the sort field was what was changed. + # @param header - identifies the header that was clicked (this is the column name not + # the title. + # + method ChangeSort header { + + # If the sort field changed we sort ascending on that field... Otherwise + # Just flip the order on the current field. + + if {$header ne $sortColumn} { + set sortColumn $header + set sortDirection -increasing + } else { + if {$sortDirection eq "-increasing"} { + set sortDirection -decreasing + } else { + set sortDirection -increasing + } + } + # Set the sort icon and schedule the update which actually sorts the table. + + $self MarkSortColumn $header $sortDirection + + $self ScheduleUpdate + } + ## + # Button 1 press handler. This establishes the starting point of a drag. + # The starting point is loaded into the lastX, lastY and the id of the item + # under that pointer is loaded into lastItem + # + # @param x,y - Widget relative coordinates of the click. This is used to + # determine the item the pointer was on. + # + method StartDrag {x y} { + set lastX $x + set lastY $y + set lastItem [$tree identify row $x $y] + } + ## + # Invoked as a result of a button 1 drag. + # How the selection changes depends on a bunch-o-stuff. + # Changes in general happen when we enter a new item. + # - If we are entering a selected item and the item + # away from the direction of motion after the left item + # was not selected, we unselect the last item. + # - Otherwise we add the entered item to the selection. + # + # Regardless, lastX, lastY, lastItem are updated. + # + # @param x,y - widget relative position of the pointer. + # + method DragTo {x y} { + set item [$tree identify row $x $y] + if {$item ne $lastItem} { + + # figure out which direction we're moving. + + set dy [expr $y - $lastY] + if {$dy < 0} { + set direction up + } else { + set direction down + } + # if the new item is not in the selection + # it should be added: + + set selection [$tree selection] + if {$item ni $selection} { + $tree selection add $item + } else { + # Figure out if lastItem needs to be + # deselected + + if {$direction eq "up"} { + set op next + } else { + set op prev + } + set awayItem [$tree $op $lastItem] + if {$awayItem ni $selection} { + $tree selection remove $lastItem + } + } + } + set lastX $x + set lastY $y + set lastItem $item + } + #----------------------------------------------------------------------- + # Option management. + + + ## + # Called to provide a new list of spectra to display. + # @param option - name of the option being configured (-spectra). + # @param value - List of spectra. Each spectrum is an 11 element list + # containing in order: + # - The spectrum name. + # - The SpecTcl Spetrum type. + # - The X Parameter name. + # - The low limit of the X axis. + # - The high limit of the X axis. + # - The number of bins on the X axis. + # - The name of the Y parameter (empty if there isn't one). + # - The low limit of the Y axis (empty if not applicable). + # - The high limit of the Y axis (empty if not applicable) + # - The number of bins on the Y axis (empty if not applicable). + # - The applied gate (empty if not applicable). + # + method SetSpectra {option value} { + set options($option) $value + + $self ScheduleUpdate + } + + #---------------------------------------------------------------------- + # + # Internal (private) methods. + + ## + # Schedule an update of the table. This will actually occur after + # updateScheduleTime to allow other updates to happen without triggering + # a pile of redraws. + # + method ScheduleUpdate {} { + if {!$updatePending} { + set updatePending 1 + after $updateScheduleTime [mymethod Update] + } + } + ## + # Do the actual update of the contents of the widget. + # - Clear the tree. + # - Sort the spectra in accordance with the requirements of sortColumn and sortDirection. + # - Add the spectra to the tree. + # - Reset the updatePending flag. + # + method Update {} { + $tree delete [$tree children {} ] + + set spectra [$self SortSpectra] + + foreach spectrum $spectra { + $tree insert {} end -values $spectrum + } + + set updatePending 0 + } + ## + # Return a sorted list of spectra. The sortColumn and sortDirection + # are used to do the sort. + # @return list of lists. + # @retval each list element is an 11 element list as described by SetSpectra. + # + method SortSpectra {} { + set listIndex [lsearch $headings $sortColumn] + + return [lsort $sortDirection -dictionary -index $listIndex $options(-spectra)] + } + ## + # Mark the sort column with the correct sorting glyph. + # Any glyphs on other columns are removed. + # @param field - The field being sorted on + # @param direction - The sort direction. + # + method MarkSortColumn {field direction} { + + set glyph $sortDirectionImage($direction) + + foreach column $headings { + if {$column eq $field} { + $tree heading $column -image $glyph + } else { + $tree heading $column -image [list]; # not the sort column no image. + } + } + } + + + +} \ No newline at end of file This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ro...@us...> - 2011-12-15 15:52:23
|
Revision: 1943 http://nsclspectcl.svn.sourceforge.net/nsclspectcl/?rev=1943&view=rev Author: ron-fox Date: 2011-12-15 15:52:15 +0000 (Thu, 15 Dec 2011) Log Message: ----------- User story 30 completed - Clear selected and all spectra from Spectrum Tab Modified Paths: -------------- trunk/SpecTcl/treegui/spectrumContainer.tcl trunk/SpecTcl/treegui/spectrumTabActions.tcl trunk/SpecTcl/treegui/spectrumTable.tcl Added Paths: ----------- trunk/SpecTcl/treegui/spectrumManipulation.tcl Modified: trunk/SpecTcl/treegui/spectrumContainer.tcl =================================================================== --- trunk/SpecTcl/treegui/spectrumContainer.tcl 2011-12-15 15:49:57 UTC (rev 1942) +++ trunk/SpecTcl/treegui/spectrumContainer.tcl 2011-12-15 15:52:15 UTC (rev 1943) @@ -15,9 +15,11 @@ package require Tk package require snit package require definitionFileWidget +package require spectrumManipulation package require spectrumMaskWidget package require spectrumTable + package provide spectrumContainer 1.0 ## @@ -51,26 +53,33 @@ delegate option -mask to mask delegate option -updatecmd to mask - # Spectrum table optinos. + # Spectrum table options and methods. delegate option -spectra to table delegate option -selectcmd to table + delegate method getSelection to table + # Spectrum manipulation options + + delegate option -all to spectrum + delegate option -clearcmd to spectrum + ## # Construction is just installing and laying out the components. # # @param args - configuration option/names. # constructor args { - install fileio using definitionFileWidget $win.fileio - install table using spectrumTable $win.table -height 15 - install mask using spectrumMaskWidget $win.mask + install fileio using definitionFileWidget $win.fileio + install table using spectrumTable $win.table -height 15 + install mask using spectrumMaskWidget $win.mask + install spectrum using spectrumManipulation $win.spectrum + grid $fileio -sticky ew + grid $spectrum -sticky ew + grid $table -sticky ew + grid $mask -sticky ew - grid $fileio -sticky ew - grid $table -sticky ew - grid $mask -sticky ew - grid columnconfigure $win all -weight 1 $self configurelist $args Added: trunk/SpecTcl/treegui/spectrumManipulation.tcl =================================================================== --- trunk/SpecTcl/treegui/spectrumManipulation.tcl (rev 0) +++ trunk/SpecTcl/treegui/spectrumManipulation.tcl 2011-12-15 15:52:15 UTC (rev 1943) @@ -0,0 +1,117 @@ +# This software is Copyright by the Board of Trustees of Michigan +# State University (c) Copyright 2009. +# +# You may use this software under the terms of the GNU public license +# (GPL). The terms of this license are described at: +# +# http://www.gnu.org/licenses/gpl.txt +# +# Author: +# Ron Fox +# NSCL +# Michigan State University +# East Lansing, MI 48824-1321 + +package require Tk +package require snit +package require treeUtilities + +package provide spectrumManipulation 1.0 + +## +# Provides a widget for manpipulating spectra. This consists of two sets of widgets. +# The top bar of widgets mostly manipulates spectra that have been created while +# the bottom bar is used to define spectra that have been created. +# +# Widget layout is: +# +# +-------------------------------------------------------------------------------------+ +# | Spectrum Name [Create/replace] [Clear] [Delete] Gate^ [Apply] | +# | [ ] [ ] Array [] All [Duplicate] [ ] [Ungate] | +# +-------------------------------------------------------------------------------------+ +# | Parameter^ Low High Bins Units | Y Parameter Low High Bins Units | +# | [ ] [ ] [ ] [ ] xxxx | [ ] [ ] [ ] [ ] xxxxx | +# +-------------------------------------------------------------------------------------+ +# +# This implies a widget construction of two frames that are gridded vertically. +# In addition the top frame has an inner pair of frames. The left one contains the +# spectrum related stuff and the right one the Gate related stuff. +# +# OPTIONS: +# -clearcmd - Script that is invoked when the Clear button is clicked on the top frame. +# %W Substitutes for the widget name. +# -all - The boolean state of the 'All' checkbutton. +# +# METHODS: +# +# +snit::widget spectrumManipulation { + hulltype ttk::frame + + option -clearcmd -default [list] + option -all -default 0 + + ## + # Construct the widget and lay it out. + # We also connect the events, bindings etc. to scripts. + # + # @args - The option name/values that configure this widget at construction time + # + constructor args { + $self configurelist $args + + # + # Set up the frame hierarchy. + + # Top frame: + + install topframe using ttk::frame $win.top -relief groove -borderwidth 2 + install spectrumops using ttk::frame $win.top.spectra -relief groove -borderwidth 2 + install gateops using ttk::frame $win.top.gates -relief groove -borderwidth 2 + + # Bottom frame: + + install bottomframe using ttk::frame $win.bottom -relief groove -borderwidth 2 + install xparameter using ttk::frame $win.bottom.x -relief groove -borderwidth 2 + install yparameter using ttk::frame $win.bottom.y -relief groove -borderwidth 2 + + # Layout the top frame now: + + ttk::button $win.top.spectra.clear -text Clear -command [mymethod Dispatch -clearcmd] + ttk::checkbutton $win.top.spectra.all -text All -variable ${selfns}::options(-all) + + # Layout the widgets: + + grid $win.top.spectra.clear -row 0 -column 2 -sticky nsew + grid $win.top.spectra.all -row 1 -column 2 -sticky nsew + grid columnconfigure $win.top.spectra 0 -weight 2 + grid columnconfigure $win.top.spectra [list 1 2 3] -weight 1 + + + grid $win.top.spectra $win.top.gates -sticky nsew + + grid columnconfigure $win.top 0 -weight 5 + grid columnconfigure $win.top 1 -weight 1 + + grid $win.top -sticky nsew + + grid $win.bottom.x $win.bottom.y -sticky nsew + grid columnconfigure $win.bottom all -weight 1 + grid $win.bottom -sticky nsew + + grid columnconfigure $win all -weight 1 + + } + + #---------------------------------------------------------------------------------------- + # Event/bindings handlers. + + ## + # Dispatch an option script. The subtitutions we provide are + # - %W - The widget ($self) + # @param option - name of the option that contains the script to dispatch. + # + method Dispatch option { + ::treeutility::dispatch $options($option) [list %W] [list $self] + } +} \ No newline at end of file Modified: trunk/SpecTcl/treegui/spectrumTabActions.tcl =================================================================== --- trunk/SpecTcl/treegui/spectrumTabActions.tcl 2011-12-15 15:49:57 UTC (rev 1942) +++ trunk/SpecTcl/treegui/spectrumTabActions.tcl 2011-12-15 15:52:15 UTC (rev 1943) @@ -132,6 +132,20 @@ } $widget configure -spectra $spectrumList } + ## + # Called in response to the button to clear spectra. + # If the -all option is true we clear all of the spectra otherwise + # only the spectra selected in the spectrum table are cleared. + # + public method ClearSpectra {} { + if {[$widget cget -all]} { + clear -all + } else { + foreach name [$widget getSelection] { + clear $name + } + } + } #--------------------------------------------------------------------------- # True public interface. There are other public methods but they # require that exposure to be used as callbacks. @@ -149,9 +163,10 @@ } spectrumContainer $widget \ - -savecmd [list $this SaveConfiguration %N] \ - -loadcmd [list $this ReadConfiguration %N %W] \ - -updatecmd [list $this LoadSpectra %M] + -savecmd [list $this SaveConfiguration %N] \ + -loadcmd [list $this ReadConfiguration %N %W] \ + -updatecmd [list $this LoadSpectra %M] \ + -clearcmd [list $this ClearSpectra] LoadSpectra [$widget cget -mask] } Modified: trunk/SpecTcl/treegui/spectrumTable.tcl =================================================================== --- trunk/SpecTcl/treegui/spectrumTable.tcl 2011-12-15 15:49:57 UTC (rev 1942) +++ trunk/SpecTcl/treegui/spectrumTable.tcl 2011-12-15 15:52:15 UTC (rev 1943) @@ -171,7 +171,8 @@ $self configurelist $args grid $tree $win.s -sticky nsew - grid columnconfigure $win all -weight 1 + grid columnconfigure $win 0 -weight 1 + grid columnconfigure $win 1 -weight 0; # Should keep the scroll bar from scaling. # Event bindings: This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ro...@us...> - 2011-12-17 20:16:15
|
Revision: 1944 http://nsclspectcl.svn.sourceforge.net/nsclspectcl/?rev=1944&view=rev Author: ron-fox Date: 2011-12-17 20:16:08 +0000 (Sat, 17 Dec 2011) Log Message: ----------- essage=Work items 32, 35 duplicate, delete and ungate spectra Modified Paths: -------------- trunk/SpecTcl/treegui/spectrumContainer.tcl trunk/SpecTcl/treegui/spectrumManipulation.tcl trunk/SpecTcl/treegui/spectrumTabActions.tcl trunk/SpecTcl/treegui/treeUtilities.tcl Modified: trunk/SpecTcl/treegui/spectrumContainer.tcl =================================================================== --- trunk/SpecTcl/treegui/spectrumContainer.tcl 2011-12-15 15:52:15 UTC (rev 1943) +++ trunk/SpecTcl/treegui/spectrumContainer.tcl 2011-12-17 20:16:08 UTC (rev 1944) @@ -63,6 +63,9 @@ delegate option -all to spectrum delegate option -clearcmd to spectrum + delegate option -deletecmd to spectrum + delegate option -dupcmd to spectrum + delegate option -ungatecmd to spectrum ## # Construction is just installing and laying out the components. Modified: trunk/SpecTcl/treegui/spectrumManipulation.tcl =================================================================== --- trunk/SpecTcl/treegui/spectrumManipulation.tcl 2011-12-15 15:52:15 UTC (rev 1943) +++ trunk/SpecTcl/treegui/spectrumManipulation.tcl 2011-12-17 20:16:08 UTC (rev 1944) @@ -48,8 +48,11 @@ snit::widget spectrumManipulation { hulltype ttk::frame - option -clearcmd -default [list] - option -all -default 0 + option -clearcmd -default [list] + option -all -default 0 + option -deletecmd -default [list] + option -dupcmd -default [list] + option -ungatecmd -default [list] ## # Construct the widget and lay it out. @@ -77,17 +80,35 @@ # Layout the top frame now: + # Spectrum operations. + ttk::button $win.top.spectra.clear -text Clear -command [mymethod Dispatch -clearcmd] ttk::checkbutton $win.top.spectra.all -text All -variable ${selfns}::options(-all) + ttk::button $win.top.spectra.delete -text Delete -command [mymethod Dispatch -deletecmd] + ttk::button $win.top.spectra.duplicate -text Duplicate -command [mymethod Dispatch -dupcmd] + + # Gate operations: + + ttk::button $win.top.gates.ungate -text Ungate -command [mymethod Dispatch -ungatecmd] + + + # Layout the widgets: - grid $win.top.spectra.clear -row 0 -column 2 -sticky nsew - grid $win.top.spectra.all -row 1 -column 2 -sticky nsew + grid $win.top.spectra.clear -row 0 -column 2 -sticky nsew + grid $win.top.spectra.delete -row 0 -column 3 -sticky nsew + + grid $win.top.spectra.all -row 1 -column 2 -sticky nsew + grid $win.top.spectra.duplicate -row 1 -column 3 -sticky nsew + + grid $win.top.gates.ungate -sticky nsew + grid columnconfigure $win.top.spectra 0 -weight 2 grid columnconfigure $win.top.spectra [list 1 2 3] -weight 1 + grid $win.top.spectra $win.top.gates -sticky nsew grid columnconfigure $win.top 0 -weight 5 Modified: trunk/SpecTcl/treegui/spectrumTabActions.tcl =================================================================== --- trunk/SpecTcl/treegui/spectrumTabActions.tcl 2011-12-15 15:52:15 UTC (rev 1943) +++ trunk/SpecTcl/treegui/spectrumTabActions.tcl 2011-12-17 20:16:08 UTC (rev 1944) @@ -27,7 +27,67 @@ itcl::class spectrumTabActions { public variable widget; # spectrumContainer widget option. + #------------------------------------------------------------------------- + # Private utility methods + # Get either selected or all spectra depending on the state of the all button. + # @return list + # @retval if all is checked a list of all spectrum names. + # @retval if all is not checked a list of the names of spectr that are selected + # in the spectrum table. + # + private method getSelectedSpectra {} { + if {[$widget cget -all]} { + set result [list] + foreach spectrum [spectrum -list] { + lappend result [lindex $spectrum 1] + } + return $result + } else { + return [$widget getSelection] + } + } + # Generate a new spectrum name based on an existing one. + # There is an assumption we will make... That already duplicated spectra + # will be of the form name_integer. There fore if a spectrum breask up into + # a list of _ separated components with size > 1, and the last element is an integer + # we should generate the spectra by incrementing the digits until we come up with one that + # results in a spectrum name that is not yet used. Otherwise just append _1 to the + # initial name...incrementing that until we get uniqueness. + # + # + # @param baseName - The initial name of the spectrum. + # @return string + # @retval - a spectrum name that is not yet in use. + # + private method generateUniqueSpectrumName baseName { + + # Figure out what the base part of the name is and the + # trailing integer should start with. + # + set baseList [split $baseName _] + if {([llength $baseList] > 1) && ([string is integer [lindex $baseList end]])} { + set counter [lindex $baseList end] + set baseList [lrange $baseList 0 end-1]; # lop off the last element. + incr counter; # and start hunting with the next integer. + } else { + set counter 1 + } + # Now hunt for a unique name by successively incrementing counter + + while 1 { + set candidateName [join [concat $baseList $counter] _] + set info [spectrum -list $candidateName] + if {[llength $info] == 0} { + return $candidateName + } else { + incr counter + } + } + + + } + #-------------------------------------------------------------------------- # Call back methods. These are, by necesity public thought not really part of # the public interface. @@ -100,7 +160,7 @@ set gate [lindex $spectrum 6] # Ungated true gate -> "" - if {$gate eq "-TRUE-"} { + if {$gate eq "-TRUE-" || $gate eq "-Ungated-"} { set gate "" } @@ -141,15 +201,75 @@ if {[$widget cget -all]} { clear -all } else { - foreach name [$widget getSelection] { - clear $name - } + ::treeutility::for_each clear [$widget getSelection] } } + ## + # Called in response to the button to delete spectra. + # + public method DeleteSpectra {} { + if {[$widget cget -all]} { + spectrum -delete -all + } else { + ::treeutility::for_each [list spectrum -delete] [$widget getSelection] + } + LoadSpectra [$widget cget -mask] + } + # Duplicate a spectrum: + # - Assign a unique name that starts like the existing spectrum. + # - Get the spectrum defintion. + # - Create the new spectrum + # - bind it to the display. + # @param name - Name of the existing spectrum to duplicate. + # + public method duplicateSpectrum name { + set newName [generateUniqueSpectrumName $name] + set def [spectrum -list $name] + + # bypass everything if there are no matching spectra. This can happen if the + # spectrum was deleted bu tthe display not updated. + # + if {[llength $def] > 0} { + set def [lindex $def 0]; # The actual definition. + + set type [lindex $def 2] + set param [lindex $def 3] + set axes [lindex $def 4] + set dataType [lindex $def 5] + + spectrum $newName $type $param $axes $dataType + } + } + ## + # Called in response to the button to duplicate spectra. + # We're going to use the following private methods: + # getSelectedSpectra - Gets the list of spectra to operate on. + # duplicateSpectrum - Duplicates a single spetrum. + # + public method DupSpectra {} { + + ::treeutility::for_each [list $this duplicateSpectrum] [getSelectedSpectra] + LoadSpectra [$widget cget -mask] + } + + ## + # Called in response to the ungate button. Ungates either the selected + # or all spectra depending on the state of the all checkbutton. + # + public method UngateSpectra {} { + set spectra [getSelectedSpectra] + if {[llength $spectra] != 0} { + ungate {*}$spectra + LoadSpectra [$widget cget -mask] + + } + + } #--------------------------------------------------------------------------- # True public interface. There are other public methods but they # require that exposure to be used as callbacks. # + ## # Construct the object and view: @@ -162,11 +282,14 @@ error "The -widget option is mandatory" } - spectrumContainer $widget \ - -savecmd [list $this SaveConfiguration %N] \ + spectrumContainer $widget \ + -savecmd [list $this SaveConfiguration %N] \ -loadcmd [list $this ReadConfiguration %N %W] \ - -updatecmd [list $this LoadSpectra %M] \ - -clearcmd [list $this ClearSpectra] + -updatecmd [list $this LoadSpectra %M] \ + -clearcmd [list $this ClearSpectra] \ + -deletecmd [list $this DeleteSpectra] \ + -dupcmd [list $this DupSpectra] \ + -ungatecmd [list $this UngateSpectra] LoadSpectra [$widget cget -mask] } Modified: trunk/SpecTcl/treegui/treeUtilities.tcl =================================================================== --- trunk/SpecTcl/treegui/treeUtilities.tcl 2011-12-15 15:52:15 UTC (rev 1943) +++ trunk/SpecTcl/treegui/treeUtilities.tcl 2011-12-17 20:16:08 UTC (rev 1944) @@ -89,3 +89,14 @@ } } +## +# Perform a command with each element of a list appended to it +# Sort of like an STL for_each +# @param cmd - the command to run. +# @param list - The list oif parameters to apply. +# +proc ::treeutility::for_each {cmd list} { + foreach element $list { + {*}$cmd $element + } +} \ No newline at end of file This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ro...@us...> - 2011-12-17 21:22:57
|
Revision: 1945 http://nsclspectcl.svn.sourceforge.net/nsclspectcl/?rev=1945&view=rev Author: ron-fox Date: 2011-12-17 21:22:50 +0000 (Sat, 17 Dec 2011) Log Message: ----------- essage=Work item 33 - Select a gate from the gate menu Modified Paths: -------------- trunk/SpecTcl/treegui/gateTabActions.tcl trunk/SpecTcl/treegui/spectrumContainer.tcl trunk/SpecTcl/treegui/spectrumManipulation.tcl trunk/SpecTcl/treegui/spectrumTabActions.tcl Modified: trunk/SpecTcl/treegui/gateTabActions.tcl =================================================================== --- trunk/SpecTcl/treegui/gateTabActions.tcl 2011-12-17 20:16:08 UTC (rev 1944) +++ trunk/SpecTcl/treegui/gateTabActions.tcl 2011-12-17 21:22:50 UTC (rev 1945) @@ -34,6 +34,10 @@ ::itcl::class gateTabActions { public variable widget "" + private variable gateAddChain; # prior gate add trace. + private variable gateDeleteChain; # prior gate delete trace. + private variable gateChangeChain; # prior gate change trace. + #------------------------------------------------------------------------------ # Private methods: @@ -97,10 +101,34 @@ $widget configure -gates $gates } + ## + # The methods below + # Are required to support chaining to prior traces: + # in all of them: + # @name is the name of the gate that fired the trace. + # + public method gateAdded name { + loadGateMenu + if {$gateAddChain ne ""} { + uplevel #0 $gateAddChain $name + } + } + public method gateDeleted name { + loadGateMenu + if {$gateDeleteChain ne ""} { + uplevel #0 $gateDeleteChain $name + } + } + public method gateChanged name { + loadGateMenu + if {$gateChangeChain ne ""} { + uplevel #0 $gateChangeChain $name + } + } ## # Load the gate menu with the names of all of the gates: - # @param args - I get passed parameters by the gate trace callback which I want to ignore. - public method loadGateMenu {args} { + # + public method loadGateMenu {} { set gates [gate -list] set names [list] foreach gate $gates { @@ -109,6 +137,8 @@ } } $widget configure -menugates $names + + # If the name was supplied we chain to any } @@ -231,13 +261,15 @@ -createcmd [list $this createGate %G %T %D] loadGateTable * - loadGateMenu + loadGateMenu # Set up a gate add/delete trace to reload the gate menu: - gate -trace add [list $this loadGateMenu] - gate -trace delete [list $this loadGateMenu] - gate -trace change [list $this loadGateMenu]; # in case change was type -> false. + set gateAddChain [gate -trace add [list $this gateAdded]] + set gateDeleteChain [gate -trace delete [list $this gateDeleted]] + set gateChangeChain [gate -trace change [list $this gateChanged]] + + } } \ No newline at end of file Modified: trunk/SpecTcl/treegui/spectrumContainer.tcl =================================================================== --- trunk/SpecTcl/treegui/spectrumContainer.tcl 2011-12-17 20:16:08 UTC (rev 1944) +++ trunk/SpecTcl/treegui/spectrumContainer.tcl 2011-12-17 21:22:50 UTC (rev 1945) @@ -61,11 +61,14 @@ # Spectrum manipulation options - delegate option -all to spectrum - delegate option -clearcmd to spectrum - delegate option -deletecmd to spectrum - delegate option -dupcmd to spectrum - delegate option -ungatecmd to spectrum + delegate option -all to spectrum + delegate option -clearcmd to spectrum + delegate option -deletecmd to spectrum + delegate option -dupcmd to spectrum + delegate option -ungatecmd to spectrum + delegate option -gates to spectrum + delegate option -gateselectcmd to spectrum + delegate option -gate to spectrum ## # Construction is just installing and laying out the components. Modified: trunk/SpecTcl/treegui/spectrumManipulation.tcl =================================================================== --- trunk/SpecTcl/treegui/spectrumManipulation.tcl 2011-12-17 20:16:08 UTC (rev 1944) +++ trunk/SpecTcl/treegui/spectrumManipulation.tcl 2011-12-17 21:22:50 UTC (rev 1945) @@ -15,6 +15,7 @@ package require Tk package require snit package require treeUtilities +package require treemenuWidget package provide spectrumManipulation 1.0 @@ -41,6 +42,8 @@ # -clearcmd - Script that is invoked when the Clear button is clicked on the top frame. # %W Substitutes for the widget name. # -all - The boolean state of the 'All' checkbutton. +# TODO: +# Add the rest of the option docs. # # METHODS: # @@ -48,11 +51,14 @@ snit::widget spectrumManipulation { hulltype ttk::frame - option -clearcmd -default [list] - option -all -default 0 - option -deletecmd -default [list] - option -dupcmd -default [list] - option -ungatecmd -default [list] + option -clearcmd -default [list] + option -all -default 0 + option -deletecmd -default [list] + option -dupcmd -default [list] + option -ungatecmd -default [list] + option -gates -default [list] -configuremethod NewGates + option -gateselectcmd -default [list] + option -gate -default [list] ## # Construct the widget and lay it out. @@ -61,7 +67,6 @@ # @args - The option name/values that configure this widget at construction time # constructor args { - $self configurelist $args # # Set up the frame hierarchy. @@ -80,6 +85,11 @@ # Layout the top frame now: + # Stock the menus now. + + $self configurelist $args + + # Spectrum operations. ttk::button $win.top.spectra.clear -text Clear -command [mymethod Dispatch -clearcmd] @@ -90,6 +100,9 @@ # Gate operations: + ttk::menubutton $win.top.gates.gatesel -text Gate -menu $win.top.gates.gatesel.gates + treeMenu $win.top.gates.gatesel.gates -command [mymethod MenuDispatch -gateselectcmd %L %N] + ttk::entry $win.top.gates.gateentry -width 12 -textvariable ${selfns}::options(-gate) ttk::button $win.top.gates.ungate -text Ungate -command [mymethod Dispatch -ungatecmd] @@ -102,7 +115,8 @@ grid $win.top.spectra.all -row 1 -column 2 -sticky nsew grid $win.top.spectra.duplicate -row 1 -column 3 -sticky nsew - grid $win.top.gates.ungate -sticky nsew + grid $win.top.gates.gatesel + grid $win.top.gates.gateentry $win.top.gates.ungate -sticky nsew grid columnconfigure $win.top.spectra 0 -weight 2 grid columnconfigure $win.top.spectra [list 1 2 3] -weight 1 @@ -135,4 +149,34 @@ method Dispatch option { ::treeutility::dispatch $options($option) [list %W] [list $self] } + ## + # Dispatch a menu selection from a tree menu. + # This differs from Dispatch in that %L %N are also substituted for. + # @param option - the option to dispatch. + # @param label - Menu label clicked. + # @param path - Full menu path clicked. + # + method MenuDispatch {option label path} { + + # The extra [list] commands below allow for paths and labels with spaces and other + # special characters. + + ::treeutility::dispatch $options($option) [list %W %L %N] [list $self [list $label] [list $path]] + } + + #------------------------------------------------------------------------------------- + # Configuration management + + ## + # Configuration of the -gates option changed...destroy and recreate the tree menu. + # @param option - name of the option that was modified. + # @param value - list of the gates to display. + # + method NewGates {option value} { + set options($option) $value + + destroy $win.top.gates.gatesel.gates + + treeMenu $win.top.gates.gatesel.gates -items $value -command [mymethod MenuDispatch -gateselectcmd %L %N] + } } \ No newline at end of file Modified: trunk/SpecTcl/treegui/spectrumTabActions.tcl =================================================================== --- trunk/SpecTcl/treegui/spectrumTabActions.tcl 2011-12-17 20:16:08 UTC (rev 1944) +++ trunk/SpecTcl/treegui/spectrumTabActions.tcl 2011-12-17 21:22:50 UTC (rev 1945) @@ -27,6 +27,11 @@ itcl::class spectrumTabActions { public variable widget; # spectrumContainer widget option. + + private variable gateAddChain + private variable gateDeleteChain + private variable gateChangeChain + #------------------------------------------------------------------------- # Private utility methods @@ -265,6 +270,48 @@ } } + ## + # Gate traces...these are separated to support + # chaining. + # @param name - the name of the gate affected. + + public method gateAdded name { + LoadGateMenu + if {$gateAddChain ne ""} { + uplevel #0 $gateAddChain $name + } + } + public method gateDeleted name { + LoadGateMenu + if {$gateDeleteChain ne ""} { + uplevel #0 $gateDeleteChain $name + } + } + public method gateChanged name { + LoadGateMenu + if {$gateChangeChain ne ""} { + uplevel #0 $gateChangeChain $name + } + } + + ## + # Called to refresh the contents of the gate menu. + # + public method LoadGateMenu {} { + set gates [list] + foreach gate [gate -list] { + lappend gates [lindex $gate 0] + } + $widget configure -gates $gates + } + ## + # Whenever a gate is selected its full path is put in the entry below the menu: + # @param name - full name of the gate. + # + public method Selectgate name { + $widget configure -gate $name + } + #--------------------------------------------------------------------------- # True public interface. There are other public methods but they # require that exposure to be used as callbacks. @@ -289,8 +336,20 @@ -clearcmd [list $this ClearSpectra] \ -deletecmd [list $this DeleteSpectra] \ -dupcmd [list $this DupSpectra] \ - -ungatecmd [list $this UngateSpectra] + -ungatecmd [list $this UngateSpectra] \ + -gateselectcmd [list $this Selectgate %N] LoadSpectra [$widget cget -mask] + + # Load the gate menu and set it up to reload each time gates change in any way: + + LoadGateMenu + + set gateAddChain [gate -trace add [list $this gateAdded]] + set gateDeleteChain [gate -trace delete [list $this gateDeleted]] + set gateChangeChain [gate -trace change [list $this getChanged]] + + + } } \ No newline at end of file This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ro...@us...> - 2011-12-19 14:39:33
|
Revision: 1946 http://nsclspectcl.svn.sourceforge.net/nsclspectcl/?rev=1946&view=rev Author: ron-fox Date: 2011-12-19 14:39:24 +0000 (Mon, 19 Dec 2011) Log Message: ----------- essage=Work item 34: Add and implement Apply gate(s) button Modified Paths: -------------- trunk/SpecTcl/treegui/spectrumContainer.tcl trunk/SpecTcl/treegui/spectrumManipulation.tcl trunk/SpecTcl/treegui/spectrumTabActions.tcl Modified: trunk/SpecTcl/treegui/spectrumContainer.tcl =================================================================== --- trunk/SpecTcl/treegui/spectrumContainer.tcl 2011-12-17 21:22:50 UTC (rev 1945) +++ trunk/SpecTcl/treegui/spectrumContainer.tcl 2011-12-19 14:39:24 UTC (rev 1946) @@ -69,6 +69,7 @@ delegate option -gates to spectrum delegate option -gateselectcmd to spectrum delegate option -gate to spectrum + delegate option -applycmd to spectrum ## # Construction is just installing and laying out the components. Modified: trunk/SpecTcl/treegui/spectrumManipulation.tcl =================================================================== --- trunk/SpecTcl/treegui/spectrumManipulation.tcl 2011-12-17 21:22:50 UTC (rev 1945) +++ trunk/SpecTcl/treegui/spectrumManipulation.tcl 2011-12-19 14:39:24 UTC (rev 1946) @@ -59,6 +59,7 @@ option -gates -default [list] -configuremethod NewGates option -gateselectcmd -default [list] option -gate -default [list] + option -applycmd -default [list] ## # Construct the widget and lay it out. @@ -102,8 +103,9 @@ ttk::menubutton $win.top.gates.gatesel -text Gate -menu $win.top.gates.gatesel.gates treeMenu $win.top.gates.gatesel.gates -command [mymethod MenuDispatch -gateselectcmd %L %N] - ttk::entry $win.top.gates.gateentry -width 12 -textvariable ${selfns}::options(-gate) - ttk::button $win.top.gates.ungate -text Ungate -command [mymethod Dispatch -ungatecmd] + ttk::button $win.top.gates.apply -text Apply -command [mymethod Dispatch -applycmd] + ttk::entry $win.top.gates.gateentry -width 12 -textvariable ${selfns}::options(-gate) + ttk::button $win.top.gates.ungate -text Ungate -command [mymethod Dispatch -ungatecmd] @@ -115,17 +117,19 @@ grid $win.top.spectra.all -row 1 -column 2 -sticky nsew grid $win.top.spectra.duplicate -row 1 -column 3 -sticky nsew - grid $win.top.gates.gatesel - grid $win.top.gates.gateentry $win.top.gates.ungate -sticky nsew + grid $win.top.gates.gatesel -row 0 -column 0 -sticky nsw + grid $win.top.gates.apply -row 0 -column 1 -sticky nse + grid $win.top.gates.gateentry -row 1 -column 0 -sticky nsw + grid $win.top.gates.ungate -row 1 -column 1 -sticky nse - grid columnconfigure $win.top.spectra 0 -weight 2 + grid columnconfigure $win.top.spectra 0 -weight 3 grid columnconfigure $win.top.spectra [list 1 2 3] -weight 1 grid $win.top.spectra $win.top.gates -sticky nsew - grid columnconfigure $win.top 0 -weight 5 + grid columnconfigure $win.top 0 -weight 9 grid columnconfigure $win.top 1 -weight 1 grid $win.top -sticky nsew Modified: trunk/SpecTcl/treegui/spectrumTabActions.tcl =================================================================== --- trunk/SpecTcl/treegui/spectrumTabActions.tcl 2011-12-17 21:22:50 UTC (rev 1945) +++ trunk/SpecTcl/treegui/spectrumTabActions.tcl 2011-12-19 14:39:24 UTC (rev 1946) @@ -312,6 +312,18 @@ $widget configure -gate $name } + ## + # Apply gates to spectra. + # + public method ApplyGates {} { + set spectra [getSelectedSpectra] + set gate [$widget cget -gate] + if {[llength $spectra] != 0} { + apply $gate {*}$spectra + } + LoadSpectra [$widget cget -mask] + } + #--------------------------------------------------------------------------- # True public interface. There are other public methods but they # require that exposure to be used as callbacks. @@ -337,7 +349,8 @@ -deletecmd [list $this DeleteSpectra] \ -dupcmd [list $this DupSpectra] \ -ungatecmd [list $this UngateSpectra] \ - -gateselectcmd [list $this Selectgate %N] + -gateselectcmd [list $this Selectgate %N] \ + -applycmd [list $this ApplyGates] LoadSpectra [$widget cget -mask] This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ro...@us...> - 2011-12-19 20:40:54
|
Revision: 1947 http://nsclspectcl.svn.sourceforge.net/nsclspectcl/?rev=1947&view=rev Author: ron-fox Date: 2011-12-19 20:40:47 +0000 (Mon, 19 Dec 2011) Log Message: ----------- Work item 161 - Load spectrum definitions and parameters Modified Paths: -------------- trunk/SpecTcl/treegui/definitionFile.tcl trunk/SpecTcl/treegui/spectrumContainer.tcl trunk/SpecTcl/treegui/spectrumManipulation.tcl trunk/SpecTcl/treegui/spectrumTabActions.tcl trunk/SpecTcl/treegui/treeUtilities.tcl Added Paths: ----------- trunk/SpecTcl/treegui/spectrumAxis.tcl trunk/SpecTcl/treegui/spectrumType.tcl Modified: trunk/SpecTcl/treegui/definitionFile.tcl =================================================================== --- trunk/SpecTcl/treegui/definitionFile.tcl 2011-12-19 14:39:24 UTC (rev 1946) +++ trunk/SpecTcl/treegui/definitionFile.tcl 2011-12-19 20:40:47 UTC (rev 1947) @@ -50,6 +50,8 @@ option -loadcmd -default [list] option -savecmd -default [list] + delegate option -relief to hull + delegate option -borderwidth to hull ## # Construct the widget. @@ -75,10 +77,10 @@ # Lay them out on the frame: - grid $win.fnamelabel -columnspan 2 - grid $win.filename -columnspan 2 - grid $win.load $win.save - grid $win.accumulate $win.failsafe + grid $win.fnamelabel -columnspan 2 -padx 5 + grid $win.filename -columnspan 2 -padx 5 + grid $win.load $win.save -padx 5 + grid $win.accumulate $win.failsafe -padx 5 grid columnconfigure $win all -weight 1 Added: trunk/SpecTcl/treegui/spectrumAxis.tcl =================================================================== --- trunk/SpecTcl/treegui/spectrumAxis.tcl (rev 0) +++ trunk/SpecTcl/treegui/spectrumAxis.tcl 2011-12-19 20:40:47 UTC (rev 1947) @@ -0,0 +1,151 @@ +# This software is Copyright by the Board of Trustees of Michigan +# State University (c) Copyright 2009. +# +# You may use this software under the terms of the GNU public license +# (GPL). The terms of this license are described at: +# +# http://www.gnu.org/licenses/gpl.txt +# +# Author: +# Ron Fox +# NSCL +# Michigan State University +# East Lansing, MI 48824-1321 + +package require Tk +package require snit +package require treeUtilities +package require treemenuWidget + +package provide spectrumAxis 1.0 + +## +# Provides a widget that implements a spectrum axis editor. +# the spectrum axis editor looks like this: +# +# +---------------------------------------------------------+ +# | <Parameter -> Low High Bins Units | +# | [ ] [ ] [ ] [ ] xxx | +# +---------------------------------------------------------+ +# +# OPTIONS: +# -parameters - loads the parametesr into the parameter pulldown menu. +# -parameter - Value of the paramter entry. +# -low - Axis low limit. +# -high - Axis high limit. +# -bins - Axis bin count. +# -units - Units of the parameter. +# -state - State of the Parameter, low, high and bins entries. +# -command - Script executed when a parameter is selected from the menu. +# +# @note The low, high, bins are constrained to hold either an empty string +# or a valid integer (e.g. string isvalid must hold). +# @note substitutions are: +# - %W - widget ($self) +# - %L - Label of menu item clicked. +# - %N - Full path to the item selected in the menu hierarchy. +# + +snit::widget spectrumAxis { + hulltype ::ttk::frame + + option -parameters -default [list] -configuremethod RebuildParameters + option -parameter -default "" + option -low -default "" + option -high -default "" + option -bins -default "" + option -units -default "" + option -state -default normal -configuremethod StateChange + + option -command -default [list] + + ## + # Construct and layout the component widgets. + # + # @param args - option name value pairs that make up the initial + # configuration of the widget. + # + constructor args { + + # Create the widgets: + + # Top row of stuff: + + ttk::menubutton $win.parametermenubutton -text "Parameter" -menu $win.parametermenu + treeMenu $win.parametermenu -command [mymethod Dispatch -command %L %N] + ttk::label $win.lowlabel -text Low + ttk::label $win.highlabel -text High + ttk::label $win.binslabel -text Bins + ttk::label $win.unitslabel -text Units + + # Bottom row of stuff: + + ttk::entry $win.parameter -textvariable ${selfns}::options(-parameter) + ttk::entry $win.low -textvariable ${selfns}::options(-low) \ + -validate key -validatecommand [mymethod ValidNumber %P] -width 7 + ttk::entry $win.high -textvariable ${selfns}::options(-high) \ + -validate key -validatecommand [mymethod ValidNumber %P] -width 7 + ttk::entry $win.bins -textvariable ${selfns}::options(-bins) \ + -validate key -validatecommand [mymethod ValidNumber %P] -width 7 + ttk::label $win.units -textvariable ${selfns}::options(-units) -width 8 + + # Grid the elements: + + grid $win.parametermenubutton $win.lowlabel $win.highlabel $win.binslabel $win.unitslabel + grid $win.parameter $win.low $win.high $win.bins $win.units + + + $self configurelist $args + } + #--------------------------------------------------------------------------------- + # Configuration management + + ## + # Configuration handler to process the -parameters option. + # we need to tear down the $win.parametermenu, and rebuild it from the list of + # parameters passed in. + # @param option - Option being configured -parameters + # @param value - New value for the option. + # + method RebuildParameters {option value} { + set options($option) $value + + destroy $win.parametermenu + treeMenu $win.parametermenu -command [mymethod Dispatch -command %L %N] \ + -items $value + } + ## + # Configuration handler to process widget state changes. We just pass the configuration + # on to the widgets the user can manipulate. + # @param option - Option being configured (-state) + # @param value - New option value. + # + method StateChange {option value} { + set options($option) $value + + foreach widget [list $win.parameter $win.parametermenubutton $win.low $win.high $win.bins] { + $widget configure -state $value + } + } + + #-------------------------------------------------------------------------------------- + # Action handlers + + ## + # Called to validate that a entry contains a number. + # @param value - Value we are attempting to put in the entry. + method ValidNumber {value} { + return [string is double $value] + } + ## + # Called to dispatch a substituted command + # @param option -the option contaning the script to run. + # @param label - Label of the menu item clicked. + # @param name - Full path to the menu entry clicked. + # + method Dispatch {option label name} { + ::treeutility::dispatch $options($option) [list %W %L %N] [list $self [list $label] [list $name]] + } + + +} \ No newline at end of file Modified: trunk/SpecTcl/treegui/spectrumContainer.tcl =================================================================== --- trunk/SpecTcl/treegui/spectrumContainer.tcl 2011-12-19 14:39:24 UTC (rev 1946) +++ trunk/SpecTcl/treegui/spectrumContainer.tcl 2011-12-19 20:40:47 UTC (rev 1947) @@ -18,6 +18,7 @@ package require spectrumManipulation package require spectrumMaskWidget package require spectrumTable +package require spectrumType package provide spectrumContainer 1.0 @@ -40,6 +41,7 @@ snit::widget spectrumContainer { hulltype ttk::frame + # definitionFileWidget options: delegate option -filename to fileio @@ -70,19 +72,53 @@ delegate option -gateselectcmd to spectrum delegate option -gate to spectrum delegate option -applycmd to spectrum + + delegate option -spectrumname to spectrum + delegate option -xparameter to spectrum + delegate option -xlow to spectrum + delegate option -xhi to spectrum + delegate option -xbins to spectrum + delegate option -xunits to spectrum + delegate option -xparamselected to spectrum + + + delegate option -yparameter to spectrum + delegate option -ylow to spectrum + delegate option -yhi to spectrum + delegate option -ybins to spectrum + delegate option -yunits to spectrum + delegate option -yparamselected to spectrum + delegate option -ystate to spectrum + + delegate option -parameters to spectrum + + # Options for the spectrum type widget: + + delegate option -spectrumtype to spectype + delegate option -datatype to spectype + delegate option -typechanged to spectype as -command + ## # Construction is just installing and laying out the components. # # @param args - configuration option/names. # constructor args { - install fileio using definitionFileWidget $win.fileio + ttk::frame $win.topmost + install fileio using definitionFileWidget $win.topmost.fileio -relief groove -borderwidth 3 + install spectype using spectrumType $win.topmost.spectrumType install table using spectrumTable $win.table -height 15 install mask using spectrumMaskWidget $win.mask install spectrum using spectrumManipulation $win.spectrum - grid $fileio -sticky ew + + grid $spectype -column 0 -row 0 -sticky nsw + grid $fileio -sticky ew -column 1 -row 0 -sticky e + grid columnconfigure $win.topmost 0 -weight 5 + grid columnconfigure $win.topmost 1 -weight 1 + grid $win.topmost -sticky ew + grid $spectrum -sticky ew grid $table -sticky ew grid $mask -sticky ew @@ -92,4 +128,9 @@ $self configurelist $args } + #---------------------------------------------------------------------- + # + # Configuration management + + } Modified: trunk/SpecTcl/treegui/spectrumManipulation.tcl =================================================================== --- trunk/SpecTcl/treegui/spectrumManipulation.tcl 2011-12-19 14:39:24 UTC (rev 1946) +++ trunk/SpecTcl/treegui/spectrumManipulation.tcl 2011-12-19 20:40:47 UTC (rev 1947) @@ -16,6 +16,7 @@ package require snit package require treeUtilities package require treemenuWidget +package require spectrumAxis package provide spectrumManipulation 1.0 @@ -61,6 +62,31 @@ option -gate -default [list] option -applycmd -default [list] + option -spectrumname -default [list] + option -parameters -default [list] -configuremethod SetParameters + + # Delegations for the axes: + + # X: + + delegate option -xparameter to xaxis as -parameter + delegate option -xlow to xaxis as -low + delegate option -xhi to xaxis as -high + delegate option -xunits to xaxis as -units + delegate option -xbins to xaxis as -bins + delegate option -xparamselected to xaxis as -command + + # Y: + + delegate option -yparameter to yaxis as -parameter + delegate option -ylow to yaxis as -low + delegate option -yhi to yaxis as -high + delegate option -yunits to yaxis as -units + delegate option -ybins to yaxis as -bins + delegate option -yparamselected to yaxis as -command + delegate option -ystate to yaxis as -state + + ## # Construct the widget and lay it out. # We also connect the events, bindings etc. to scripts. @@ -92,6 +118,9 @@ # Spectrum operations. + + ttk::label $win.top.spectra.label -text {SpectrumName} + ttk::entry $win.top.spectra.name -textvariable ${selfns}::options(-spectrumname) ttk::button $win.top.spectra.clear -text Clear -command [mymethod Dispatch -clearcmd] ttk::checkbutton $win.top.spectra.all -text All -variable ${selfns}::options(-all) @@ -99,6 +128,7 @@ ttk::button $win.top.spectra.duplicate -text Duplicate -command [mymethod Dispatch -dupcmd] + # Gate operations: ttk::menubutton $win.top.gates.gatesel -text Gate -menu $win.top.gates.gatesel.gates @@ -107,10 +137,19 @@ ttk::entry $win.top.gates.gateentry -width 12 -textvariable ${selfns}::options(-gate) ttk::button $win.top.gates.ungate -text Ungate -command [mymethod Dispatch -ungatecmd] + # The two axis widgets: + install xaxis using spectrumAxis $win.bottom.x.axis + install yaxis using spectrumAxis $win.bottom.y.axis + + # Layout the widgets: + + grid $win.top.spectra.label -row 0 -column 0 -sticky nsew + grid $win.top.spectra.name -row 1 -column 0 -sticky nsew + grid $win.top.spectra.clear -row 0 -column 2 -sticky nsew grid $win.top.spectra.delete -row 0 -column 3 -sticky nsew @@ -134,6 +173,9 @@ grid $win.top -sticky nsew + grid $win.bottom.x.axis + grid $win.bottom.y.axis + grid $win.bottom.x $win.bottom.y -sticky nsew grid columnconfigure $win.bottom all -weight 1 grid $win.bottom -sticky nsew @@ -183,4 +225,16 @@ treeMenu $win.top.gates.gatesel.gates -items $value -command [mymethod MenuDispatch -gateselectcmd %L %N] } + ## + # Configure the parameters into the two parameter pull downs. + # @param option - name of option (-parameters) + # @param value - New value of the option. + # + method SetParameters {option value} { + set options($option) $value + + + $xaxis configure -parameters $value + $yaxis configure -parameters $value + } } \ No newline at end of file Modified: trunk/SpecTcl/treegui/spectrumTabActions.tcl =================================================================== --- trunk/SpecTcl/treegui/spectrumTabActions.tcl 2011-12-19 14:39:24 UTC (rev 1946) +++ trunk/SpecTcl/treegui/spectrumTabActions.tcl 2011-12-19 20:40:47 UTC (rev 1947) @@ -34,7 +34,35 @@ #------------------------------------------------------------------------- # Private utility methods + + ## Given a parameter name get the units: + # @param name - parameter name + # @return string + # @retval possibly empty string containing parameter units. + # + private method getUnits name { + set def [parameter -list $name] + if {[llength $def] > 0} { + set def [lindex $def 0] + set paramInfo [lindex $def 3] + return [lindex $paramInfo 2] + } + return {} + } + + ## + # Load the parameter names into the parameter menus. + # + private method LoadParameters {} { + set parameters [list] + foreach parameter [parameter -list] { + lappend parameters [lindex $parameter 0] + } + $widget configure -parameters $parameters + } + + ## # Get either selected or all spectra depending on the state of the all button. # @return list # @retval if all is checked a list of all spectrum names. @@ -52,6 +80,7 @@ return [$widget getSelection] } } + ## # Generate a new spectrum name based on an existing one. # There is an assumption we will make... That already duplicated spectra # will be of the form name_integer. There fore if a spectrum breask up into @@ -324,6 +353,119 @@ LoadSpectra [$widget cget -mask] } + ## + # Select a spectrum and load it into the spectrum definition fields. + # + # @param name - The name of the spectrum. + # + public method SelectSpectrum name { + set def [spectrum -list $name] + + # If the spectrum became undefined do nothing: + + if {[llength $def] > 0} { + set def [lindex $def 0] + set name [lindex $def 1] + set type [lindex $def 2] + set params [lindex $def 3] + set axes [lindex $def 4] + set datatype [lindex $def 5] + + set xParam [lindex $params 0] + set xAxis [lindex $axes 0] + set xlow [lindex $xAxis 0] + set xhi [lindex $xAxis 1] + set xbins [lindex $xAxis 2] + + + $widget configure -spectrumtype $type \ + -datatype $datatype \ + -spectrumname $name \ + -xparameter $xParam \ + -xlow $xlow \ + -xhi $xhi \ + -xbins $xbins + + # Figure out units + + $widget configure -xunits [getUnits $xParam] + + if {[llength $axes] > 1} { + set yparam [lindex $params 1] + set yaxis [lindex $axes 1] + set ylow [lindex $yaxis 0] + set yhi [lindex $yaxis 1] + set ybins [lindex $yaxis 2] + + $widget configure -yparameter $yparam \ + -ylow $ylow -yhi $yhi -ybins $ybins \ + -yunits [getUnits $yparam] -ystate normal + } else { + $widget configure -ystate disabled + } + + } + } + ## + # Load a parameter into one of the axis widgets along with the suggested + # values (if this is a tree parameter). + # @param which - x or y - selects which of the parameter widgets to load. + # @param name - Name of the parameter. + # + public method LoadParameter {which name} { + # + # If there's a tree parameter by that name use it: + + set tdef [treeparameter -list $name] + if {[llength $tdef] > 0} { + set tdef [lindex $tdef 0] + set bins [lindex $tdef 1] + set lo [lindex $tdef 2] + set hi [lindex $tdef 3] + set units [lindex $tdef 5] + + + } else { + # Otherwise if there's a parameter by that name use what we can from it: + + set pdef [parameter -list $name] + if {[llength $pdef] > 0} { + set pdef [lindex $pdef 0] + set info [lindex $pdef 3] + set bins [list] + set lo [lindex $info 0] + set hi [lindex $info 1] + set units [lindex $info 2] + + } else { + # no such parameter so exit out: + return + } + } + # If we got here the name, lo, hi, bins and units are set: + + $widget configure \ + -${which}parameter $name \ + -${which}low $lo \ + -${which}hi $hi \ + -${which}bins $bins \ + -${which}units $units + + + } + ## + # The spectrum type changed..figure out what the state of the y axis should be. + # only if it's 2 should we enable it: + # + public method ChangeSpectype {} { + set type [$widget cget -spectrumtype] + if {$type eq 2} { + $widget configure -ystate normal + } else { + $widget configure -ystate disabled + } + } + #--------------------------------------------------------------------------- # True public interface. There are other public methods but they # require that exposure to be used as callbacks. @@ -342,6 +484,7 @@ } spectrumContainer $widget \ + -ystate disabled \ -savecmd [list $this SaveConfiguration %N] \ -loadcmd [list $this ReadConfiguration %N %W] \ -updatecmd [list $this LoadSpectra %M] \ @@ -350,8 +493,15 @@ -dupcmd [list $this DupSpectra] \ -ungatecmd [list $this UngateSpectra] \ -gateselectcmd [list $this Selectgate %N] \ - -applycmd [list $this ApplyGates] + -applycmd [list $this ApplyGates] \ + -selectcmd [list $this SelectSpectrum %N] \ + -typechanged [list $this ChangeSpectype] \ + -xparamselected [list $this LoadParameter x %N] \ + -yparamselected [list $this LoadParameter y %N] + + LoadParameters + LoadSpectra [$widget cget -mask] # Load the gate menu and set it up to reload each time gates change in any way: @@ -361,8 +511,8 @@ set gateAddChain [gate -trace add [list $this gateAdded]] set gateDeleteChain [gate -trace delete [list $this gateDeleted]] set gateChangeChain [gate -trace change [list $this getChanged]] + - } } \ No newline at end of file Added: trunk/SpecTcl/treegui/spectrumType.tcl =================================================================== --- trunk/SpecTcl/treegui/spectrumType.tcl (rev 0) +++ trunk/SpecTcl/treegui/spectrumType.tcl 2011-12-19 20:40:47 UTC (rev 1947) @@ -0,0 +1,122 @@ +# This software is Copyright by the Board of Trustees of Michigan +# State University (c) Copyright 2009. +# +# You may use this software under the terms of the GNU public license +# (GPL). The terms of this license are described at: +# +# http://www.gnu.org/licenses/gpl.txt +# +# Author: +# Ron Fox +# NSCL +# Michigan State University +# East Lansing, MI 48824-1321 + +package require Tk +package require snit +package require treeUtilities + + +package provide spectrumType 1.0 + + +## +# This class provides the spectum type selector. +# This contains the following widgets laid out as follows: +# +# +------------------------------------------------------+ +# | () 1D () Stripchart | () Word (16 bits) | +# | () 2D () Bitmask | () Long (32 bits) | +# +------------------------------------------------------+ +# +# Note that the original provided additional spectrum types +# that we don't because the they really can't be represented by the +# mechanics provided. The original GUI also provided byte data types +# we don't bother with either. +# +# OPTIONS: +# -spectrumtype - SpecTcl spectrum type contained by the radio button. +# NOTE if is possible for this value to be 'invalid' +# for the radio buttons but valid for SpecTcl. +# -datatype - Value of data type radio button. In addition to the +# SpecTcl types of word and long, this could possibly +# have the value of 'byte' +# +# @note currently all types of spectra support all data types, so there's +# no need to couple the data types to the spectrum types. Note as well +# that SpecTcl supports a Byte (8 bits) data type but as I'd be surprised +# if anybody uses it it's going to be omitted here. +# + +snit::widget spectrumType { + hulltype ttk::frame + + option -spectrumtype -default 1 -configuremethod Dispatch + option -datatype -default long + option -command -default [list] + + ## + # Construct the widget. No behavior is really required. + # + # @param args - the option name value pairs that make up the initial configuration. + # + constructor args { + $self configurelist $args + + ttk::frame $win.spectypes -relief groove -borderwidth 3 + ttk::frame $win.datatypes -relief groove -borderwidth 3 + + # The radio button set for spectrum types + + ttk::label $win.spectypes.typelabel -text "Spectrum Type" + foreach type [list 1 2 S b] label [list 1D 2D Stripchart Bitmask] { + ttk::radiobutton $win.spectypes.t$type -text $label \ + -variable ${selfns}::options(-spectrumtype) -value $type \ + -command [mymethod dispatch] + } + # The radio button set for data types: + + ttk::label $win.datatypes.datatypelabel -text "Data Type" + foreach type [list word long] label [list "Word (16 bits)" "Long (32 bits)"] { + ttk::radiobutton $win.datatypes.d$type -text $label -value $type \ + -variable ${selfns}::options(-datatype) + } + + # Layout the widgets and frame: + + grid $win.spectypes.typelabel -columnspan 2 + grid $win.spectypes.t1 $win.spectypes.tS -sticky nsw -padx 15 -pady 5 + grid $win.spectypes.t2 $win.spectypes.tb -sticky nsw -padx 15 -pady 5 + + grid $win.datatypes.datatypelabel + grid $win.datatypes.dword -sticky nsw -pady 5 -padx 15 + grid $win.datatypes.dlong -sticky nsw -pady 5 -padx 15 + + grid $win.spectypes -row 0 -column 0 -sticky nsw + grid $win.datatypes -row 0 -column 1 -sticky nse + + } + #---------------------------------------------------------------------------------- + # Configuration mangement + + ## + # Dispatch to a user script if the spectrum type changed. + # @param option -the configuration option changing. + # @param value - new value. + # + method Dispatch {option value} { + set options($option) $value + + $self dispatch + } + + #------------------------------------------------------------------------- + # Event handlers: + + ## + # Dispatch the -command script: + # + method dispatch {} { + ::treeutility::dispatch $options(-command) [list] [list] + } +} \ No newline at end of file Modified: trunk/SpecTcl/treegui/treeUtilities.tcl =================================================================== --- trunk/SpecTcl/treegui/treeUtilities.tcl 2011-12-19 14:39:24 UTC (rev 1946) +++ trunk/SpecTcl/treegui/treeUtilities.tcl 2011-12-19 20:40:47 UTC (rev 1947) @@ -93,7 +93,7 @@ # Perform a command with each element of a list appended to it # Sort of like an STL for_each # @param cmd - the command to run. -# @param list - The list oif parameters to apply. +# @param list - The list of parameters to apply. # proc ::treeutility::for_each {cmd list} { foreach element $list { This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ro...@us...> - 2011-12-19 21:52:36
|
Revision: 1948 http://nsclspectcl.svn.sourceforge.net/nsclspectcl/?rev=1948&view=rev Author: ron-fox Date: 2011-12-19 21:52:29 +0000 (Mon, 19 Dec 2011) Log Message: ----------- essage=work item 28 - create a new spectrum Modified Paths: -------------- trunk/SpecTcl/treegui/definitionFile.tcl trunk/SpecTcl/treegui/spectrumContainer.tcl trunk/SpecTcl/treegui/spectrumManipulation.tcl trunk/SpecTcl/treegui/spectrumTabActions.tcl Modified: trunk/SpecTcl/treegui/definitionFile.tcl =================================================================== --- trunk/SpecTcl/treegui/definitionFile.tcl 2011-12-19 20:40:47 UTC (rev 1947) +++ trunk/SpecTcl/treegui/definitionFile.tcl 2011-12-19 21:52:29 UTC (rev 1948) @@ -67,7 +67,7 @@ ttk::button $win.load -text Load -command [mymethod DispatchLoad] ttk::button $win.save -text Save -command [mymethod DispatchSave] - ttk::checkbutton $win.accumulate -text Cumulate \ + ttk::checkbutton $win.accumulate -text Cumulative \ -onvalue 1 -offvalue 0 \ -variable ${selfns}::options(-accumulate) Modified: trunk/SpecTcl/treegui/spectrumContainer.tcl =================================================================== --- trunk/SpecTcl/treegui/spectrumContainer.tcl 2011-12-19 20:40:47 UTC (rev 1947) +++ trunk/SpecTcl/treegui/spectrumContainer.tcl 2011-12-19 21:52:29 UTC (rev 1948) @@ -92,6 +92,8 @@ delegate option -ystate to spectrum delegate option -parameters to spectrum + delegate option -createcmd to spectrum + delegate option -array to spectrum # Options for the spectrum type widget: Modified: trunk/SpecTcl/treegui/spectrumManipulation.tcl =================================================================== --- trunk/SpecTcl/treegui/spectrumManipulation.tcl 2011-12-19 20:40:47 UTC (rev 1947) +++ trunk/SpecTcl/treegui/spectrumManipulation.tcl 2011-12-19 21:52:29 UTC (rev 1948) @@ -64,6 +64,8 @@ option -spectrumname -default [list] option -parameters -default [list] -configuremethod SetParameters + option -createcmd -default [list] + option -array -default 0 # Delegations for the axes: @@ -121,6 +123,10 @@ ttk::label $win.top.spectra.label -text {SpectrumName} ttk::entry $win.top.spectra.name -textvariable ${selfns}::options(-spectrumname) + + ttk::button $win.top.spectra.create -text Create/Replace -command [mymethod Dispatch -createcmd] + ttk::checkbutton $win.top.spectra.array -text Array -onvalue 1 -offvalue 0 \ + -variable ${selfns}::options(-array) ttk::button $win.top.spectra.clear -text Clear -command [mymethod Dispatch -clearcmd] ttk::checkbutton $win.top.spectra.all -text All -variable ${selfns}::options(-all) @@ -150,6 +156,9 @@ grid $win.top.spectra.label -row 0 -column 0 -sticky nsew grid $win.top.spectra.name -row 1 -column 0 -sticky nsew + grid $win.top.spectra.create -row 0 -column 1 -sticky w + grid $win.top.spectra.array -row 1 -column 1 -sticky w + grid $win.top.spectra.clear -row 0 -column 2 -sticky nsew grid $win.top.spectra.delete -row 0 -column 3 -sticky nsew Modified: trunk/SpecTcl/treegui/spectrumTabActions.tcl =================================================================== --- trunk/SpecTcl/treegui/spectrumTabActions.tcl 2011-12-19 20:40:47 UTC (rev 1947) +++ trunk/SpecTcl/treegui/spectrumTabActions.tcl 2011-12-19 21:52:29 UTC (rev 1948) @@ -81,6 +81,21 @@ } } ## + # Determine if any of a list of items is null. + # @param list - list of items + # @return boolean + # @return true - if at least one item is null. + # @return false - if no items are null. + # + private method anyNulls list { + foreach item $list { + if {$item eq ""} { + return 1 + } + } + return 0 + } + ## # Generate a new spectrum name based on an existing one. # There is an assumption we will make... That already duplicated spectra # will be of the form name_integer. There fore if a spectrum breask up into @@ -121,7 +136,28 @@ } + ## + # True if the user says its ok to replace a spectrum: + # @param name - the spectrum name. + # @return bool + # @retval true if the user accepts. + # + private method okToReplaceSpectrum name { + if {[llength [spectrum -list $name]] > 0} { + if {[tk_messageBox -default cancel -icon warning -parent $widget \ + -title Overwite -type okcancel \ + -message "$name already exists replace?"] eq "ok"} { + return 1 + } else { + return 0 + } + } else { + # It's always ok to replace a nonexistent spectrum: + return 1 + } + } + #-------------------------------------------------------------------------- # Call back methods. These are, by necesity public thought not really part of # the public interface. @@ -390,7 +426,7 @@ $widget configure -xunits [getUnits $xParam] - if {[llength $axes] > 1} { + if {[llength $params] > 1} { set yparam [lindex $params 1] set yaxis [lindex $axes 1] set ylow [lindex $yaxis 0] @@ -455,17 +491,92 @@ } ## # The spectrum type changed..figure out what the state of the y axis should be. - # only if it's 2 should we enable it: + # only if it's 2, or S (stripchart) should we enable it: # public method ChangeSpectype {} { set type [$widget cget -spectrumtype] - if {$type eq 2} { + if {($type eq 2) || ($type eq "S")} { $widget configure -ystate normal } else { $widget configure -ystate disabled } } + ## Invoked to create a spectrum. + # + public method CreateSpectrum {} { + # If the spectrum exists prompt for redef: + # + # We must have at least the following: + # - spectrum name + # - spectrum type + # - Xaxis. The rest depends on the type of spectrum. + + set type [$widget cget -spectrumtype] + set datatype [$widget cget -datatype] + set name [$widget cget -spectrumname] + + set xname [$widget cget -xparameter] + set xlow [$widget cget -xlow] + set xhi [$widget cget -xhi] + set xbins [$widget cget -xbins] + + # Do nothing if any of the above are empty: + + if {[anyNulls [list $type $datatype $name $xname $xlow $xhi $xbins]]} { + return + } + + + # What happens next depends entirely on the spectrum type + # Bitmask and 1d define essentially the same. + # 2d and Stripchart need different defs. + # + + switch -exact -- $type { + 1 - b { + if {[okToReplaceSpectrum $name]} { + catch {spectrum -delete $name}; # get rid of any prior spectrum. + spectrum $name $type $xname [list [list $xlow $xhi $xbins]] $datatype + } + } + S { + # Need a y parameter too: + + set yname [$widget cget -yparameter] + + if {($yname ne "") && [okToReplaceSpectrum $name]} { + catch {spectrum -delete $name} + spectrum $name $type [list $xname $yname] [list [list $xlow $xhi $xbins]] $datatype + sbind $name + } + } + 2 { + # Need y parameter and axis definitions. + + set yname [$widget cget -yparameter] + set ylow [$widget cget -ylow] + set yhi [$widget cget -yhi] + set ybins [$widget cget -ybins] + + if {![anyNulls [list $yname $ylow $yhi $ybins]] && [okToReplaceSpectrum $name]} { + catch {spectrum -delete $name} + spectrum $name $type [list $xname $yname] \ + [list [list $xlow $xhi $xbins] [list $ylow $yhi $ybins]] $datatype + sbind $name + } + } + default { + tk_messageBox -type ok -icon error -title {Can't make this spectrum} \ + -parent $widget \ + -message "The tree gui does not know how to create spectra of type: $type" + sbind $name + } + } + + LoadSpectra [$widget cget -mask] + } + #--------------------------------------------------------------------------- # True public interface. There are other public methods but they # require that exposure to be used as callbacks. @@ -497,7 +608,8 @@ -selectcmd [list $this SelectSpectrum %N] \ -typechanged [list $this ChangeSpectype] \ -xparamselected [list $this LoadParameter x %N] \ - -yparamselected [list $this LoadParameter y %N] + -yparamselected [list $this LoadParameter y %N] \ + -createcmd [list $this CreateSpectrum] LoadParameters This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ro...@us...> - 2011-12-20 17:47:53
|
Revision: 1950 http://nsclspectcl.svn.sourceforge.net/nsclspectcl/?rev=1950&view=rev Author: ron-fox Date: 2011-12-20 17:47:43 +0000 (Tue, 20 Dec 2011) Log Message: ----------- Simplify focus management Modified Paths: -------------- trunk/SpecTcl/treegui/gateCreate.tcl trunk/SpecTcl/treegui/spectrumAxis.tcl trunk/SpecTcl/treegui/treeParameterWidget.tcl trunk/SpecTcl/treegui/treeVariableEditor.tcl Modified: trunk/SpecTcl/treegui/gateCreate.tcl =================================================================== --- trunk/SpecTcl/treegui/gateCreate.tcl 2011-12-19 21:53:33 UTC (rev 1949) +++ trunk/SpecTcl/treegui/gateCreate.tcl 2011-12-20 17:47:43 UTC (rev 1950) @@ -117,8 +117,8 @@ $win.type configure -width $labelLen - ttk::entry $win.name -textvariable ${selfns}::options(-gatename) - ttk::entry $win.definition -textvariable ${selfns}::options(-definition) -width 32 + ttk::entry $win.name -textvariable ${selfns}::options(-gatename) -takefocus 1 + ttk::entry $win.definition -textvariable ${selfns}::options(-definition) -width 32 -takefocus 1 # # Layout the widget. Modified: trunk/SpecTcl/treegui/spectrumAxis.tcl =================================================================== --- trunk/SpecTcl/treegui/spectrumAxis.tcl 2011-12-19 21:53:33 UTC (rev 1949) +++ trunk/SpecTcl/treegui/spectrumAxis.tcl 2011-12-20 17:47:43 UTC (rev 1950) @@ -71,7 +71,7 @@ # Top row of stuff: - ttk::menubutton $win.parametermenubutton -text "Parameter" -menu $win.parametermenu + ttk::menubutton $win.parametermenubutton -text "Parameter" -menu $win.parametermenu -takefocus 0 treeMenu $win.parametermenu -command [mymethod Dispatch -command %L %N] ttk::label $win.lowlabel -text Low ttk::label $win.highlabel -text High @@ -80,13 +80,17 @@ # Bottom row of stuff: - ttk::entry $win.parameter -textvariable ${selfns}::options(-parameter) + ttk::entry $win.parameter -textvariable ${selfns}::options(-parameter) \ + -takefocus 1 ttk::entry $win.low -textvariable ${selfns}::options(-low) \ - -validate key -validatecommand [mymethod ValidNumber %P] -width 7 + -validate key -validatecommand [mymethod ValidNumber %P] -width 7 \ + -takefocus 1 ttk::entry $win.high -textvariable ${selfns}::options(-high) \ - -validate key -validatecommand [mymethod ValidNumber %P] -width 7 + -validate key -validatecommand [mymethod ValidNumber %P] -width 7 \ + -takefocus 1 ttk::entry $win.bins -textvariable ${selfns}::options(-bins) \ - -validate key -validatecommand [mymethod ValidNumber %P] -width 7 + -validate key -validatecommand [mymethod ValidNumber %P] -width 7 \ + -takefocus 1 ttk::label $win.units -textvariable ${selfns}::options(-units) -width 8 # Grid the elements: @@ -123,8 +127,12 @@ method StateChange {option value} { set options($option) $value + # Disable/enable focus taking appropriately: + + set focus [expr {($value eq "normal") ? 1 : 0}] + foreach widget [list $win.parameter $win.parametermenubutton $win.low $win.high $win.bins] { - $widget configure -state $value + $widget configure -state $value -takefocus $focus } } Modified: trunk/SpecTcl/treegui/treeParameterWidget.tcl =================================================================== --- trunk/SpecTcl/treegui/treeParameterWidget.tcl 2011-12-19 21:53:33 UTC (rev 1949) +++ trunk/SpecTcl/treegui/treeParameterWidget.tcl 2011-12-20 17:47:43 UTC (rev 1950) @@ -61,13 +61,7 @@ option -changecmd [list] option -title false; # If true titles are put above the text entries. - # The variable below is the focus order ring: - # It allows us to build methods focusLeft and focusRight that shift focus - # the appropriate direction around the ring. - # Note that $win is not necessarily defined here so we just put the widget - # name tails: - variable focusRing [list .name .low .high .unit] ## @@ -96,17 +90,17 @@ foreach entry [list .name .low .high .unit] optionname [list -name -low -high -units] \ width [list 32 5 5 10] { ::ttk::entry $win$entry -textvariable ${selfns}::options($optionname) \ - -width $width + -width $width -takefocus 1 - # Bindings that move focus right: + # Bindings that move focus right.. note that tab is a next focus anyway. - foreach binding [list <Tab> <Return> <Right>] { - bind $win$entry $binding [list after 2 [mymethod focusRight $entry]] + foreach binding [list <Return> <Right>] { + bind $win$entry $binding [list after 2 [mymethod focusRight %W]]; # $entry]] } - # Bindings that move focus left: + # Bindings that move focus left:..note that shift-tab moves focus anyway. - foreach binding [list <Shift-Tab> <Left> <ISO_Left_Tab>] { - bind $win$entry $binding [list after 2 [mymethod focusLeft $entry]] + foreach binding [list <Left>] { + bind $win$entry $binding [list after 2 [mymethod focusLeft %W]];# $entry]] } } @@ -146,22 +140,13 @@ # @param tail tail of current widgetname... actual widget is $win.$tail # method focusRight tail { - set currentIndex [lsearch -exact $focusRing $tail] - set nextIndex [expr {($currentIndex+1) % [llength $focusRing]}] - set nextWidget $win[lindex $focusRing $nextIndex] - - focus $nextWidget + focus [tk_focusNext $tail] } ## # Change the focus to the prior widget in the focus ring. # @param tail # method focusLeft tail { - set currentIndex [lsearch -exact $focusRing $tail] - set nextIndex [expr {($currentIndex-1) % [llength $focusRing]}] - set nextWidget $win[lindex $focusRing $nextIndex] - - focus $nextWidget - + focus [tk_focusPrev $tail] } } \ No newline at end of file Modified: trunk/SpecTcl/treegui/treeVariableEditor.tcl =================================================================== --- trunk/SpecTcl/treegui/treeVariableEditor.tcl 2011-12-19 21:53:33 UTC (rev 1949) +++ trunk/SpecTcl/treegui/treeVariableEditor.tcl 2011-12-20 17:47:43 UTC (rev 1950) @@ -103,28 +103,26 @@ for {set row 1} {$row <= $options(-lines)} {incr row} { ttk::radiobutton $win.radio$row -value $row -variable ${selfns}::options(-current) - ttk::entry $win.name$row -width 32 - ttk::entry $win.value$row -width 10 - ttk::entry $win.units$row -width 10 + ttk::entry $win.name$row -width 32 -takefocus 1 + ttk::entry $win.value$row -width 10 -takefocus 1 + ttk::entry $win.units$row -width 10 -takefocus 1 ttk::button $win.load$row -text Load -command [mymethod ReloadDispatch $row] ttk::button $win.set$row -text Set -command [mymethod SetVariable $row] grid $win.radio$row $win.name$row $win.value$row $win.units$row $win.load$row $win.set$row - # Bindings for this row as well: + # Bindings for this row as well.. note that tab/shift tab normally change focus. - foreach binding [list <Tab> <Return> <Right> ] { + foreach binding [list <Return> <Right> ] { foreach \ - widget [list $win.name$row $win.value$row $win.units$row] \ - nextwidget [list $win.value$row $win.units$row $win.name$row] { - bind $widget $binding [list after 2 focus $nextwidget] + widget [list $win.name$row $win.value$row $win.units$row] { + bind $widget $binding [mymethod changeFocus tk_focusNext %W] } } - foreach binding [list <Shift-Tab> <Left> <ISO_Left_Tab> ] { + foreach binding [list <Left>] { foreach \ - widget [list $win.name$row $win.value$row $win.units$row] \ - prior [list $win.units$row $win.name$row $win.value$row] { - bind $widget $binding [list after 2 focus $prior] + widget [list $win.name$row $win.value$row $win.units$row] { + bind $widget $binding [mymethod changeFocus tk_focusPrev %W] } } } @@ -213,7 +211,18 @@ #--------------------------------------------------------------------- # Private utilities. # + ## + # Change the focus: + # @param nextcmd - command that determines the next widget given the current widget. + # @param widget - Current widget. + # + method changeFocus {nextcmd widget} { + # after since entry widgets do immediate focus games with some chars. + + after 2 {focus [$nextcmd $widget]}; + } + ## # Dispatch to a script at the global level with substitutions: # This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ro...@us...> - 2011-12-20 18:27:21
|
Revision: 1951 http://nsclspectcl.svn.sourceforge.net/nsclspectcl/?rev=1951&view=rev Author: ron-fox Date: 2011-12-20 18:27:10 +0000 (Tue, 20 Dec 2011) Log Message: ----------- Work item 29 - make create array of spectra work. Modified Paths: -------------- trunk/SpecTcl/treegui/parametersTabActions.tcl trunk/SpecTcl/treegui/spectrumContainer.tcl trunk/SpecTcl/treegui/spectrumManipulation.tcl trunk/SpecTcl/treegui/spectrumTabActions.tcl trunk/SpecTcl/treegui/treeUtilities.tcl Modified: trunk/SpecTcl/treegui/parametersTabActions.tcl =================================================================== --- trunk/SpecTcl/treegui/parametersTabActions.tcl 2011-12-20 17:47:43 UTC (rev 1950) +++ trunk/SpecTcl/treegui/parametersTabActions.tcl 2011-12-20 18:27:10 UTC (rev 1951) @@ -220,7 +220,7 @@ # private method listArrayElements sampleName { - return [::treeutility::listArrayElements $sampleName [list $this parameterList]] + return [::treeutility::listArrayElements $sampleName treeutility::parameterList] } @@ -267,15 +267,7 @@ # @note false is the default so that we can't accidently kill stuff as easily. # private method promptChangeOk spectra { - set spectra [join $spectra {, }] - set message "The following spectra wil be erased and replaced: \n$spectra\n" - append message "Do you wish to continue?" - - set answer [tk_messageBox -type yesno -default no \ - -icon warning -message $message -parent $widget -title {Confirm Change}] - - return [expr $answer eq "yes"] - + return [::treeutility::okToReplaceSpectra $spectra] } ## @@ -300,7 +292,7 @@ error "The -widget option is mandatory for parametersTabActions" } - treeParametersContainer $widget -number $lines -parameters [parameterList] \ + treeParametersContainer $widget -number $lines -parameters [treeutility::parameterList] \ -choosecmd [list $this loadCurrentEditor %N] \ -loadcmd [list $this reloadEditor %S] \ -set [list $this setParameter %S] \ @@ -445,18 +437,6 @@ } } - ## - # Get a list of the tree parameter names: - # - public method parameterList {{pattern *}} { - set treeParameters [treeparameter -list $pattern] - set result [list] - foreach param $treeParameters { - lappend result [lindex $param 0] - } - - return $result - } } Modified: trunk/SpecTcl/treegui/spectrumContainer.tcl =================================================================== --- trunk/SpecTcl/treegui/spectrumContainer.tcl 2011-12-20 17:47:43 UTC (rev 1950) +++ trunk/SpecTcl/treegui/spectrumContainer.tcl 2011-12-20 18:27:10 UTC (rev 1951) @@ -94,6 +94,7 @@ delegate option -parameters to spectrum delegate option -createcmd to spectrum delegate option -array to spectrum + delegate option -arraystate to spectrum # Options for the spectrum type widget: Modified: trunk/SpecTcl/treegui/spectrumManipulation.tcl =================================================================== --- trunk/SpecTcl/treegui/spectrumManipulation.tcl 2011-12-20 17:47:43 UTC (rev 1950) +++ trunk/SpecTcl/treegui/spectrumManipulation.tcl 2011-12-20 18:27:10 UTC (rev 1951) @@ -66,6 +66,7 @@ option -parameters -default [list] -configuremethod SetParameters option -createcmd -default [list] option -array -default 0 + # Delegations for the axes: @@ -88,7 +89,9 @@ delegate option -yparamselected to yaxis as -command delegate option -ystate to yaxis as -state + delegate option -arraystate to array as -state + ## # Construct the widget and lay it out. # We also connect the events, bindings etc. to scripts. @@ -125,7 +128,7 @@ ttk::entry $win.top.spectra.name -textvariable ${selfns}::options(-spectrumname) ttk::button $win.top.spectra.create -text Create/Replace -command [mymethod Dispatch -createcmd] - ttk::checkbutton $win.top.spectra.array -text Array -onvalue 1 -offvalue 0 \ + install array using ttk::checkbutton $win.top.spectra.array -text Array -onvalue 1 -offvalue 0 \ -variable ${selfns}::options(-array) ttk::button $win.top.spectra.clear -text Clear -command [mymethod Dispatch -clearcmd] Modified: trunk/SpecTcl/treegui/spectrumTabActions.tcl =================================================================== --- trunk/SpecTcl/treegui/spectrumTabActions.tcl 2011-12-20 17:47:43 UTC (rev 1950) +++ trunk/SpecTcl/treegui/spectrumTabActions.tcl 2011-12-20 18:27:10 UTC (rev 1951) @@ -157,7 +157,9 @@ return 1 } } - + ## + # True if its ok to replace a list of spectra: + # #-------------------------------------------------------------------------- # Call back methods. These are, by necesity public thought not really part of # the public interface. @@ -496,9 +498,9 @@ public method ChangeSpectype {} { set type [$widget cget -spectrumtype] if {($type eq 2) || ($type eq "S")} { - $widget configure -ystate normal + $widget configure -ystate normal -arraystate disabled } else { - $widget configure -ystate disabled + $widget configure -ystate disabled -arraystate normal } } ## Invoked to create a spectrum. @@ -535,9 +537,43 @@ switch -exact -- $type { 1 - b { - if {[okToReplaceSpectrum $name]} { - catch {spectrum -delete $name}; # get rid of any prior spectrum. - spectrum $name $type $xname [list [list $xlow $xhi $xbins]] $datatype + # + # 1d and bitmask spectra support the array checkbutton: + # + if {[$widget cget -array]} { + # Get the names of the parameters and the corresponding spectrum names: + + set parameterList [::treeutility::listArrayElements $xname ::treeutility::parameterList] + set spectrumList [list]; # List of spectra to create + set existingSpectra [list]; # List of previously existing spectra: + + foreach parameter $parameterList { + set tail [lindex [split $parameter .] end] + lappend spectrumList $name.$tail + set currentInfo [spectrum -list $name.$tail] + if {[llength $currentInfo] != 0} { + lappend existingSpectra [lindex [lindex $currentInfo 0] 1] + } + + } + # + # Be sure it's ok to re-define the existing spectra + # + if {([llength $existingSpectra] == 0) || + [::treeutility::okToReplaceSpectra $existingSpectra]} { + foreach parameter $parameterList spectrum $spectrumList { + catch {spectrum -delete $spectrum} + spectrum $spectrum $type $parameter \ + [list [list $xlow $xhi $xbins]] $datatype + sbind $spectrum + } + } + } else { + if {[okToReplaceSpectrum $name]} { + catch {spectrum -delete $name}; # get rid of any prior spectrum. + spectrum $name $type $xname [list [list $xlow $xhi $xbins]] $datatype + sbind $name + } } } S { @@ -595,7 +631,7 @@ } spectrumContainer $widget \ - -ystate disabled \ + -ystate disabled -arraystate normal \ -savecmd [list $this SaveConfiguration %N] \ -loadcmd [list $this ReadConfiguration %N %W] \ -updatecmd [list $this LoadSpectra %M] \ @@ -610,6 +646,7 @@ -xparamselected [list $this LoadParameter x %N] \ -yparamselected [list $this LoadParameter y %N] \ -createcmd [list $this CreateSpectrum] + LoadParameters Modified: trunk/SpecTcl/treegui/treeUtilities.tcl =================================================================== --- trunk/SpecTcl/treegui/treeUtilities.tcl 2011-12-20 17:47:43 UTC (rev 1950) +++ trunk/SpecTcl/treegui/treeUtilities.tcl 2011-12-20 18:27:10 UTC (rev 1951) @@ -99,4 +99,37 @@ foreach element $list { {*}$cmd $element } -} \ No newline at end of file +} +## +# Get a list of the tree parameter names: +# @param pattern - optional glob pattern the parameter must match .. defaults to * +# @return list +# @retval list of parameter names that match the pattern. +# +proc ::treeutility::parameterList {{pattern *}} { + set treeParameters [treeparameter -list $pattern] + set result [list] + + foreach param $treeParameters { + lappend result [lindex $param 0] + } + + return $result +} +## +# Prompt about replacing a list of spectra: +# @param spectra - names of spectra to replace. +# @return bool +# @retval true if the user confirms, false otherwise. +# +proc ::treeutility::okToReplaceSpectra spectra { + + set spectra [join $spectra {, }] + set message "The following spectra wil be erased and replaced: \n$spectra\n" + append message "Do you wish to continue?" + + set answer [tk_messageBox -type yesno -default no \ + -icon warning -message $message -title {Confirm Change}] + + return [expr $answer eq "yes"] +} This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ro...@us...> - 2011-12-30 21:08:46
|
Revision: 1956 http://nsclspectcl.svn.sourceforge.net/nsclspectcl/?rev=1956&view=rev Author: ron-fox Date: 2011-12-30 21:08:40 +0000 (Fri, 30 Dec 2011) Log Message: ----------- Add dynamic typing to the Parameter tab name field.s Modified Paths: -------------- trunk/SpecTcl/treegui/parametersTabActions.tcl trunk/SpecTcl/treegui/treeParameterWidget.tcl trunk/SpecTcl/treegui/treeParametersContainer.tcl Modified: trunk/SpecTcl/treegui/parametersTabActions.tcl =================================================================== --- trunk/SpecTcl/treegui/parametersTabActions.tcl 2011-12-30 20:23:11 UTC (rev 1955) +++ trunk/SpecTcl/treegui/parametersTabActions.tcl 2011-12-30 21:08:40 UTC (rev 1956) @@ -292,11 +292,13 @@ error "The -widget option is mandatory for parametersTabActions" } + treeParametersContainer $widget -number $lines -parameters [treeutility::parameterList] \ -choosecmd [list $this loadCurrentEditor %N] \ -loadcmd [list $this reloadEditor %S] \ -set [list $this setParameter %S] \ - -change [list $this changeSpectra %S] + -change [list $this changeSpectra %S] \ + -namechanged [list $this nameChanged %S] } @@ -437,6 +439,24 @@ } } + ## + # Invoked if the name of a parameter widget changed. + # - fetch the name. + # - If the name corresponds to a treeparameter name load the editor. + # - IF not put ? in the entries that contain the parameter information. + # + # @param slot - slot that changed. + # + public method nameChanged slot { + set name [lindex [$widget get $slot] 0] + set paramInfo [treeparameter -list $name] + if {[llength $paramInfo] > 0} { + loadSlot $slot $name + } else { + $widget load $slot $name ? ? ? + } + + } } Modified: trunk/SpecTcl/treegui/treeParameterWidget.tcl =================================================================== --- trunk/SpecTcl/treegui/treeParameterWidget.tcl 2011-12-30 20:23:11 UTC (rev 1955) +++ trunk/SpecTcl/treegui/treeParameterWidget.tcl 2011-12-30 21:08:40 UTC (rev 1956) @@ -46,6 +46,7 @@ # <Return> Moves the focus forward to the next field. # <Right> Moves focus forward to the next field. # <Left> Moves focus back to the prior field. +# <Key>(name only) Calls -namechanged script. # # @@ -60,6 +61,7 @@ option -setcmd [list] option -changecmd [list] option -title false; # If true titles are put above the text entries. + option -namechanged [list] @@ -103,6 +105,11 @@ bind $win$entry $binding [list after 2 [mymethod focusLeft %W]];# $entry]] } } + + # The after here is used to ensure the entry got updated by the key + # before invoking the callback. + + bind $win.name <Key> +[list after 1 [mymethod callback -namechanged]] # then the buttons: Modified: trunk/SpecTcl/treegui/treeParametersContainer.tcl =================================================================== --- trunk/SpecTcl/treegui/treeParametersContainer.tcl 2011-12-30 20:23:11 UTC (rev 1955) +++ trunk/SpecTcl/treegui/treeParametersContainer.tcl 2011-12-30 21:08:40 UTC (rev 1956) @@ -48,6 +48,7 @@ # -set - Command script to run when a set button is clicked. # -change - Command script to run when a Change Spectra button is clicked. # -array - Boolean that indicates/changes the array checkbutton. +# -namechanged - The name in a parameter editor changed. # # METHODS # get ?n? - Returns the contents of the editor widget n or if omitted @@ -61,7 +62,7 @@ # ACTION SCRIPT SUBSITUTIONS: # %W - provides our widget name. # %I - provides the widget name of the menu name for -## -choosecmd and the specific editor widget for load/set/change scripts. +## -choosecmd and the specific editor widget for load/set/change/namechanged scripts. # %L - only for -choosecmd provides the terminal label. # %N - only for -choosecmd provides the path to the terminal label selected. # %S - Provides the slot for the button clicks. @@ -76,6 +77,7 @@ option -set -default [list] option -change -default [list] option -array -default false + option -namechanged -default [list] variable menuButton; # The button that is attached to the hierarchy menu. @@ -113,7 +115,8 @@ treeParameterEditor $win.e$i -title $title \ -loadcmd [mymethod ButtonClicked %W $i -loadcmd] \ -setcmd [mymethod ButtonClicked %W $i -set] \ - -changecmd [mymethod ButtonClicked %W $i -change] + -changecmd [mymethod ButtonClicked %W $i -change] \ + -namechanged [mymethod ButtonClicked %W $i -namechanged] grid $win.b$i -row $i -column 0 -sticky ew -pady 0 grid $win.e$i -row $editorRow -column 1 -rowspan $rowspan -sticky ewns -pady 0 This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ro...@us...> - 2012-01-01 15:47:34
|
Revision: 1958 http://nsclspectcl.svn.sourceforge.net/nsclspectcl/?rev=1958&view=rev Author: ron-fox Date: 2012-01-01 15:47:28 +0000 (Sun, 01 Jan 2012) Log Message: ----------- Work item 109 - Support dynamic typing in the tree parameter tab name entry field.s Modified Paths: -------------- trunk/SpecTcl/treegui/treeVariableContainer.tcl trunk/SpecTcl/treegui/treeVariableEditor.tcl trunk/SpecTcl/treegui/variableTabActions.tcl Modified: trunk/SpecTcl/treegui/treeVariableContainer.tcl =================================================================== --- trunk/SpecTcl/treegui/treeVariableContainer.tcl 2011-12-30 21:11:13 UTC (rev 1957) +++ trunk/SpecTcl/treegui/treeVariableContainer.tcl 2012-01-01 15:47:28 UTC (rev 1958) @@ -41,6 +41,7 @@ delegate option -loadcmd to editors delegate option -setcmd to editors delegate option -array to editors + delegate option -namechanged to editors delegate option -loadfile to loadsave as -loadcmd delegate option -savefile to loadsave as -savecmd Modified: trunk/SpecTcl/treegui/treeVariableEditor.tcl =================================================================== --- trunk/SpecTcl/treegui/treeVariableEditor.tcl 2011-12-30 21:11:13 UTC (rev 1957) +++ trunk/SpecTcl/treegui/treeVariableEditor.tcl 2012-01-01 15:47:28 UTC (rev 1958) @@ -60,6 +60,7 @@ # %I - Index of the selected editor. # %W - Widget of the selected editor. # -array - 0 if the array check button is off 1 otherwise. +# -namechanged - Script invoked if the name field of one of the editors changed. # # METHODS: # loadEditor - Loads the contents of a specific editor. @@ -77,6 +78,7 @@ option -loadcmd -default [list] option -setcmd -default [list] option -array -default 0 + option -namechanged -default [list] ## #Create/layout the widgets and set up the callbacks and bindings. @@ -125,6 +127,10 @@ bind $widget $binding [mymethod changeFocus tk_focusPrev %W] } } + # The after in this binding allows the entry to change so a get + # of the value reflects the contents after the keystroke. + # + bind $win.name$row <Key> [list after 1 [mymethod Keystroke $row]] } } #------------------------------------------------------------------------------ @@ -223,6 +229,21 @@ after 2 {focus [$nextcmd $widget]}; } + ## + # Dispatch a name change callback: + # @param row - The row of the editor that had a name change. + # + # Substitutions: + # - %W - This megawidget. + # - %I - The row of the widget that was modified. + # - %N - The contents of the name after the stubstition. + # + method Keystroke row { + set entryWidget $win.name$row + + $self Dispatch $options(-namechanged) [list %W %I %N] [list $win $row [list [$win.name$row get]]] + } + ## # Dispatch to a script at the global level with substitutions: # @@ -233,5 +254,5 @@ method Dispatch {script substs values} { ::treeutility::dispatch $script $substs $values } - + } \ No newline at end of file Modified: trunk/SpecTcl/treegui/variableTabActions.tcl =================================================================== --- trunk/SpecTcl/treegui/variableTabActions.tcl 2011-12-30 21:11:13 UTC (rev 1957) +++ trunk/SpecTcl/treegui/variableTabActions.tcl 2012-01-01 15:47:28 UTC (rev 1958) @@ -120,7 +120,28 @@ public method RestoreVariables name { uplevel #0 source $name } + ## + # A tree variable name field has changed. If the current value matches + # a known tree variable the editor is loaded with its current value + # and units..otherwise the value/units are loaded with ?'s. + # + # @param index - Index of the editor that changed. + # @param name - New value of the name field. + # + public method NameChanged {index name} { + set info [treevariable -list $name] + if {[llength $info] > 0} { + set info [lindex $info 0] + set value [lindex $info 1] + set units [lindex $info 2] + $widget loadEditor $index $name $value $units + } else { + $widget loadEditor $index $name ? ? + } + } + + #-------------------------------------------------------------------- # public interface @@ -140,7 +161,8 @@ -loadcmd [list $this LoadVariable %N %I] \ -setcmd [list $this SetVariable %N %V %U] \ -savefile [list $this SaveVariables %F] \ - -loadfile [list $this RestoreVariables %F] + -loadfile [list $this RestoreVariables %F] \ + -namechanged [list $this NameChanged %I %N] } This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ro...@us...> - 2012-01-01 16:45:27
|
Revision: 1959 http://nsclspectcl.svn.sourceforge.net/nsclspectcl/?rev=1959&view=rev Author: ron-fox Date: 2012-01-01 16:45:21 +0000 (Sun, 01 Jan 2012) Log Message: ----------- Workitem 100 -Get failsafe working correctly. Modified Paths: -------------- trunk/SpecTcl/treegui/definitionFile.tcl trunk/SpecTcl/treegui/gateTabActions.tcl trunk/SpecTcl/treegui/parametersTabActions.tcl trunk/SpecTcl/treegui/spectrumContainer.tcl trunk/SpecTcl/treegui/spectrumTabActions.tcl trunk/SpecTcl/treegui/variableTabActions.tcl Added Paths: ----------- trunk/SpecTcl/treegui/autosave.tcl Added: trunk/SpecTcl/treegui/autosave.tcl =================================================================== --- trunk/SpecTcl/treegui/autosave.tcl (rev 0) +++ trunk/SpecTcl/treegui/autosave.tcl 2012-01-01 16:45:21 UTC (rev 1959) @@ -0,0 +1,87 @@ +# This software is Copyright by the Board of Trustees of Michigan +# State University (c) Copyright 2009. +# +# You may use this software under the terms of the GNU public license +# (GPL). The terms of this license are described at: +# +# http://www.gnu.org/licenses/gpl.txt +# +# Author: +# Ron Fox +# NSCL +# Michigan State University +# East Lansing, MI 48824-1321 + +package require treeUtilities +package require Itcl + +package provide autosave 1.0 + +## +# This Itcl class provides a singleton that is in charge +# of doing auto saves to failsafe.tcl in the cwd. +# The singleton provides the following methods: +# +# - getInstance -static that returns (constructing as needed) the instance +# - enableFailsafe - Turns on failsafe saves. +# - disableFailsafe - Turns off failsafe saves. +# - failsafeSave - If failsafe is enabled, saves the state of the system. +# +itcl::class autoSave { + private common instance [list] + private variable enabled 0 + + #---------------------------------------------------------------- + # + # Public interface: + + ## + # retrieve (create if needed) the singleton instance + # + # @return Name of the one instance of this class. + public proc getInstance {} { + if {$instance == [list]} { + autoSave ::#auto + } + return $instance + } + ## + # turn on failsafe saving: + # + public method enableFailsafe {} { + set enabled 1 + } + ## + # Turn off failsafe saving: + # + public method disableFailsafe {} { + set enabled 0 + } + ## + # Save if failsafe is enabled: + # + public method failsafeSave {} { + if {$enabled} { + set fd [open failsafe.tcl w] + set prior $::guistate::writeDeletes + set $::guistate::writeDeletes 0 + writeAll $fd + close $fd + set ::guistate::WriteDeletes $prior + } + } + ## + # In the singleton pattern, the construtor is labeled private + # so that it can only be invoked, if needed by the getInstance + # common method. + private constructor {} { + if {$instance ne [list]} { + error "Singleton-ness violated for autoSave" + } + set enabled 1 + set instance $this + + + } + +} \ No newline at end of file Modified: trunk/SpecTcl/treegui/definitionFile.tcl =================================================================== --- trunk/SpecTcl/treegui/definitionFile.tcl 2012-01-01 15:47:28 UTC (rev 1958) +++ trunk/SpecTcl/treegui/definitionFile.tcl 2012-01-01 16:45:21 UTC (rev 1959) @@ -34,6 +34,7 @@ # -makefailsafe - The state of the Failsafe checkbutton. # -loadcmd - Script that is called when the Load button is clicked. # -savecmd - Script that is called whenthe Save button is clicked. +# -failsafechanged - Script called if failsafe checkbutton changes. # # SUBSTITUTIONS: # Callbacks support the following susbitutions: @@ -49,6 +50,7 @@ option -makefailsafe -default 1 option -loadcmd -default [list] option -savecmd -default [list] + option -failsafechanged -default [list] delegate option -relief to hull delegate option -borderwidth to hull @@ -73,7 +75,8 @@ ttk::checkbutton $win.failsafe -text Failsafe \ -onvalue 1 -offvalue 0 \ - -variable ${selfns}::options(-makefailsafe) + -variable ${selfns}::options(-makefailsafe) \ + -command [mymethod DispatchFsChanged] # Lay them out on the frame: @@ -113,6 +116,15 @@ # Action handlers for the user interface. ## + # Dispatch the change of the failsafe button: + # Substitutions: + # %W -widget + # + method DispatchFsChanged {} { + ::treeutility::dispatch $options(-failsafechanged) [list %W] [list $self] + } + + ## # Handle the Save button. This dispatches to the -savecmd after first # prompting for a filename. If no filename is given no callback is # performed. If no script is registered nothing happens as well. Modified: trunk/SpecTcl/treegui/gateTabActions.tcl =================================================================== --- trunk/SpecTcl/treegui/gateTabActions.tcl 2012-01-01 15:47:28 UTC (rev 1958) +++ trunk/SpecTcl/treegui/gateTabActions.tcl 2012-01-01 16:45:21 UTC (rev 1959) @@ -192,6 +192,7 @@ gate -delete $gate } updateGates + [autoSave::getInstance] failsafeSave } ## # Prompt for confirmation and, if we get it, delete all of the @@ -211,7 +212,9 @@ } } updateGates + [autoSave::getInstance] failsafeSave } + } ## # Callback invoked to create/modify a gate. @@ -233,6 +236,8 @@ updateGates } } + [autoSave::getInstance] failsafeSave + } #------------------------------------------------------------------------------- # Public interfaces Modified: trunk/SpecTcl/treegui/parametersTabActions.tcl =================================================================== --- trunk/SpecTcl/treegui/parametersTabActions.tcl 2012-01-01 15:47:28 UTC (rev 1958) +++ trunk/SpecTcl/treegui/parametersTabActions.tcl 2012-01-01 16:45:21 UTC (rev 1959) @@ -102,6 +102,7 @@ set axes [lreplace $axes $which $which $axis] return $axes + } ## @@ -375,6 +376,8 @@ } } + [autoSave::getInstance] failsafeSave + } ## @@ -431,11 +434,13 @@ foreach parameter $spectraModified($spectrum) { modifySpectra $spectrum $parameter $low $hi } + [autoSave::getInstance] failsafeSave; # Only if we modify spectra. } } } else { notifyNoMatches } + } } Modified: trunk/SpecTcl/treegui/spectrumContainer.tcl =================================================================== --- trunk/SpecTcl/treegui/spectrumContainer.tcl 2012-01-01 15:47:28 UTC (rev 1958) +++ trunk/SpecTcl/treegui/spectrumContainer.tcl 2012-01-01 16:45:21 UTC (rev 1959) @@ -49,6 +49,7 @@ delegate option -makefailsafe to fileio delegate option -loadcmd to fileio delegate option -savecmd to fileio + delegate option -failsafechanged to fileio # Spectrum mask options: Modified: trunk/SpecTcl/treegui/spectrumTabActions.tcl =================================================================== --- trunk/SpecTcl/treegui/spectrumTabActions.tcl 2012-01-01 15:47:28 UTC (rev 1958) +++ trunk/SpecTcl/treegui/spectrumTabActions.tcl 2012-01-01 16:45:21 UTC (rev 1959) @@ -18,6 +18,8 @@ package require spectrumContainer package require guistate +package require autosave + package provide spectrumTabActions 1.0 @@ -212,6 +214,7 @@ # uplevel #0 source $name + [autoSave::getInstance] failsafeSave } ## @@ -286,6 +289,7 @@ ::treeutility::for_each [list spectrum -delete] [$widget getSelection] } LoadSpectra [$widget cget -mask] + [autoSave::getInstance] failsafeSave } # Duplicate a spectrum: # - Assign a unique name that starts like the existing spectrum. @@ -310,6 +314,7 @@ set dataType [lindex $def 5] spectrum $newName $type $param $axes $dataType + } } ## @@ -322,6 +327,8 @@ ::treeutility::for_each [list $this duplicateSpectrum] [getSelectedSpectra] LoadSpectra [$widget cget -mask] + [autoSave::getInstance] failsafeSave + } ## @@ -335,6 +342,7 @@ LoadSpectra [$widget cget -mask] } + [autoSave::getInstance] failsafeSave } ## @@ -389,6 +397,8 @@ apply $gate {*}$spectra } LoadSpectra [$widget cget -mask] + [autoSave::getInstance] failsafeSave + } ## @@ -611,8 +621,25 @@ } LoadSpectra [$widget cget -mask] + [autoSave::getInstance] failsafeSave + } + ## + # Called when the failsafe button has changed; + # Get the state of the button and set the auotsave singleton accordingly. + # + # + public method ChangeFailsafe {} { + set state [$widget cget -makefailsafe] + set autosave [autoSave::getInstance] + if {$state} { + $autosave enableFailsafe + } else { + $autosave disableFailsafe + } + } + #--------------------------------------------------------------------------- # True public interface. There are other public methods but they # require that exposure to be used as callbacks. @@ -645,7 +672,8 @@ -typechanged [list $this ChangeSpectype] \ -xparamselected [list $this LoadParameter x %N] \ -yparamselected [list $this LoadParameter y %N] \ - -createcmd [list $this CreateSpectrum] + -createcmd [list $this CreateSpectrum] \ + -failsafechanged [list $this ChangeFailsafe] Modified: trunk/SpecTcl/treegui/variableTabActions.tcl =================================================================== --- trunk/SpecTcl/treegui/variableTabActions.tcl 2012-01-01 15:47:28 UTC (rev 1958) +++ trunk/SpecTcl/treegui/variableTabActions.tcl 2012-01-01 16:45:21 UTC (rev 1959) @@ -19,6 +19,7 @@ package provide variableTabActions 1.0 + ## # Provides the behavior associated with the tree variables editor tab. # OPTIONS @@ -81,6 +82,8 @@ treevariable -firetraces $name } } + [autoSave::getInstance] failsafeSave + } ## # Return a list of the tree variable names. @@ -119,6 +122,8 @@ # public method RestoreVariables name { uplevel #0 source $name + [autoSave::getInstance] failsafeSave + } ## # A tree variable name field has changed. If the current value matches This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ro...@us...> - 2012-01-03 14:32:17
|
Revision: 1961 http://nsclspectcl.svn.sourceforge.net/nsclspectcl/?rev=1961&view=rev Author: ron-fox Date: 2012-01-03 14:32:11 +0000 (Tue, 03 Jan 2012) Log Message: ----------- Work item 207 - Restore variable states and - Ensure that state can be cleared prior to a reload. Modified Paths: -------------- trunk/SpecTcl/treegui/parametersTabActions.tcl trunk/SpecTcl/treegui/restore.tcl trunk/SpecTcl/treegui/treeVariableContainer.tcl trunk/SpecTcl/treegui/treeVariableEditor.tcl trunk/SpecTcl/treegui/variableTabActions.tcl Modified: trunk/SpecTcl/treegui/parametersTabActions.tcl =================================================================== --- trunk/SpecTcl/treegui/parametersTabActions.tcl 2012-01-02 13:24:59 UTC (rev 1960) +++ trunk/SpecTcl/treegui/parametersTabActions.tcl 2012-01-03 14:32:11 UTC (rev 1961) @@ -310,6 +310,7 @@ # Register an observer to restore the state of the editors etc.: + [Restore::getInstance] addPreObserver ParameterTab [itcl::code clearLayoutVariables] [Restore::getInstance] addObserver ParameterTab [list $this restoreLayout] } @@ -319,8 +320,17 @@ # Internal callbacks. # NOTE: itcl requires these to be public but they are not part of the class # interface. - + ## + # unset the ::parameter array prior to reloading a configuration file. + # + private proc clearLayoutVariables {} { + if {[array exists ::parameter]} { + unset ::parameter + } + } + + ## # Restore the layout after a read from file. # See saveLayout for how the layout is saved. # @@ -385,7 +395,7 @@ public method saveLayout fd { set lines [$widget cget -number]; # Number of parameter lines to interrogate/save: - puts $fd "# - Parameter tab layout: " + puts $fd "\n# - Parameter tab layout: \n" # Contents of the editors: Modified: trunk/SpecTcl/treegui/restore.tcl =================================================================== --- trunk/SpecTcl/treegui/restore.tcl 2012-01-02 13:24:59 UTC (rev 1960) +++ trunk/SpecTcl/treegui/restore.tcl 2012-01-03 14:32:11 UTC (rev 1961) @@ -20,6 +20,8 @@ # # Public methods provided are: # - getInstance - Get the singleton instance +# - addPreObserver - Adds an observer called prior to state restor. +# - removePreobserver - Removes a pre-observer. # - addObserver - Adds an observer that is called after the state restore. # - removeObserver - Remove an observer that has been added via addObserver. # - restore - Restore state of the software. @@ -29,7 +31,26 @@ itcl::class Restore { private common instance [list] private variable observers + private variable preObservers + + #----------------------------------------------------------------- + # + # Private utilities + + ## + # Invoke a set of observers. + # + # @param observerList the result of an [array get] on an observers array. + # this is a list of the form index1 value1 index2 value2... + # + private method invokeObservers observerList { + + foreach [list name value] $observerList { + uplevel #0 $value + } + } + #-------------------------------------------------------------------- # # Public interface @@ -50,11 +71,34 @@ private constructor {} { if {$instance ne [list]} { - error "Singleton-ness violated for autoSave" + error "Singleton-ness violated for restore" } array set observers [list] + array set preObservers [list] set instance $this } + ## Add an observer invoked prior to state restore. If state is saved + # in global variables this gives an observing object a chance to clear + # that state first. + # + # @param name - name identifying the observer. This is in a namespace + # distinct from the (post)observer namespace. + # @param script - Script to run when the observer is triggered. + # + public method addPreObserver {name script} { + set preObservers($name) $script + } + ## + # Remove a pre restore observer + # + # @param name - Name of the observer to delete. + # This is a no-op if no observer by that name was established.] + # + public method removePreObserver name { + if {[array names preObservers $name] eq $name} { + array unset preObservers $name + } + } ## # Add an observer to the set of observers invoked on a restore. @@ -83,11 +127,13 @@ # @param name - filename to be sourced. # public method restore name { + + invokeObservers [array get preObservers] + uplevel #0 source $name - foreach observerName [array names observers] { - uplevel #0 $observers($observerName) - } + invokeObservers [array get observers] + } } Modified: trunk/SpecTcl/treegui/treeVariableContainer.tcl =================================================================== --- trunk/SpecTcl/treegui/treeVariableContainer.tcl 2012-01-02 13:24:59 UTC (rev 1960) +++ trunk/SpecTcl/treegui/treeVariableContainer.tcl 2012-01-03 14:32:11 UTC (rev 1961) @@ -25,6 +25,7 @@ # Contains tree variables editors and the load/save strip at the bottom of that widget. # # OPTIONS: +# TODO: update the options and describe them. # -variables - Delegated to treeVariableEditor. # -lines - Delegated to treeVariableEditor. # -current - Delegated to treeVariableEditor. @@ -48,6 +49,7 @@ delegate option -filename to loadsave delegate method loadEditor to editors + delegate method getEditor to editors ## # install the components and lay them out. Modified: trunk/SpecTcl/treegui/treeVariableEditor.tcl =================================================================== --- trunk/SpecTcl/treegui/treeVariableEditor.tcl 2012-01-02 13:24:59 UTC (rev 1960) +++ trunk/SpecTcl/treegui/treeVariableEditor.tcl 2012-01-03 14:32:11 UTC (rev 1961) @@ -64,6 +64,8 @@ # # METHODS: # loadEditor - Loads the contents of a specific editor. +# getEditor - Get the contents of a specific editor. +# # AUTONOMOUS ACTIONS: # Tab, Return, Right navigates circularly on the editor in focus to the right # Shift-Tab, Left ISO_Left_Tab navigates circularly on the editor in focus to the left. @@ -151,6 +153,20 @@ $widget insert 0 $value } } + ## + # Return a list of the values in a specific editor: + # + # @param editor - index of the editor. + # + # @return list + # @retval [list name value units] + # + method getEditor editor { + foreach widget [list $win.name$editor $win.value$editor $win.units$editor] { + lappend result [$widget get] + } + return $result + } #------------------------------------------------------------------------------- Modified: trunk/SpecTcl/treegui/variableTabActions.tcl =================================================================== --- trunk/SpecTcl/treegui/variableTabActions.tcl 2012-01-02 13:24:59 UTC (rev 1960) +++ trunk/SpecTcl/treegui/variableTabActions.tcl 2012-01-03 14:32:11 UTC (rev 1961) @@ -16,6 +16,7 @@ package require Itcl package require treeVariableContainer package require guistate; # From 'folder gui'. +package require restore package provide variableTabActions 1.0 @@ -39,7 +40,80 @@ #------------------------------------------------------------------- # Callbacks (note these must be public to work + ## + # Observer method to save the layout of the editors. + # This is called as part of the process of writing a configuration file. + # + # @param fd - file descriptor open on the configuration file. + # + # @note The layout is saved in an array named variable with the following indices: + # - Namei - The name in the i'th slot of the editor. + # - Valuei - The value in the i'th slot of the editor. + # - Uniti - The untis of the i'th slot of the editor. + # - Arraty - The state of the array checkbutton. + # - select - The editor line that is currently selected. + # + private method saveLayout fd { + + puts $fd "\n#-- Variable tab layout\n"; + + # Save the lines that have a non-blank name: + + set lines [$widget cget -lines] + for {set i 1} {$i <= $lines} {incr i} { + set info [$widget getEditor $i] + set name [lindex $info 0] + if {$name ne ""} { + set value [lindex $info 1] + set units [lindex $info 2] + + puts $fd "set variable(Name$i) [list $name]"; # List will handle names with spaces etc. + puts $fd "set variable(Value$i) $value" + puts $fd "set variable(Unit$i) [list $units]"; # Handles e.g. m / s as well as m/s. + + } + } + # Now the selected and array states: + + puts $fd "set variable(select) [$widget cget -current]" + puts $fd "set variable(Array) [$widget cget -array]" + } + + ## + # Clear any layout variables that are lying around prior to a restore. + # + private proc clearLayoutVariables {} { + if {[array exists ::variable]} { + unset ::variable + } + } + ## + # Observer called after a save file is restored. This + # restores the layout from the variable array. + # See saveLayout for the indices in that array. + # + private method restoreLayout {} { + + # First restore the contents of the editors: + + set lines [$widget cget -lines] + for {set i 1} {$i <= $lines} {incr i} { + if {[array name ::variable Name$i] eq "Name$i"} { + $widget loadEditor $i $::variable(Name$i) $::variable(Value$i) $::variable(Unit$i) + } else { + $widget loadEditor $i "" "" ""; # Empty the line. + } + } + # Set the selection and the array checkbox. + # Being lazy here using catch in case the array elements don't exist. + + catch {$widget configure -current $::variable(select)} + catch {$widget configure -array $::variable(Array)} + + } + + ## # Called when a variable is selected from the tree menu, # The variable is loaded into the currently seleted editor. # @param name - tree variable name. @@ -168,6 +242,13 @@ -savefile [list $this SaveVariables %F] \ -loadfile [list $this RestoreVariables %F] \ -namechanged [list $this NameChanged %I %N] + + # Add observers for save and restore so that we can + # save our gui state. + + addSaveObserver variableTabLayout [itcl::code $this saveLayout] + [Restore::getInstance] addPreObserver variableTabLayout [itcl::code clearLayoutVariables] + [Restore::getInstance] addObserver variableTabLayout [itcl::code $this restoreLayout] } This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |