Ticket UUID: | fa5d30b3b3a6dd021d0c84b5a4a49127b8cdf1ed | |||
Title: | Add Widget::which procedure | |||
Type: | Patch | Version: | 1.9.7 | |
Submitter: | anonymous | Created on: | 2014-05-14 09:58:53 | |
Subsystem: | (unused) | Assigned To: | nobody | |
Priority: | 5 Medium | Severity: | Minor | |
Status: | Closed | Last Modified: | 2014-05-21 07:34:37 | |
Resolution: | Accepted | Closed By: | oehhar | |
Closed on: | 2014-05-21 07:34:37 | |||
Description: |
From: Adrián Medraño Calvo <[email protected]> Add new procedure Widget::which (as in [namespace which]), that returns the fully qualified name for a widget option or widget variable. The new procedure provides access to the fully qualifed name for a widget variable (i.e, those created with Widget::getVariable) allowing, for example, setting traces on such variables. The new procedure subsumes the [Widget::varForOption] functionality. The latter command has been rewriten so as to not duplicate code. In order to mantain compatibility, the new procedure throws an error when requesting the fully-qualified variable name for a non-existing option, as did [Widget::varForOption]. This limitation does not exist for widget variables, as it would prevent setting traces before their creation. --- bwidget-1.9.7/widget.tcl | 70 +++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 58 insertions(+), 12 deletions(-) diff --git a/bwidget-1.9.7/widget.tcl b/bwidget-1.9.7/widget.tcl index d4748f3..6a40832 100755 --- a/bwidget-1.9.7/widget.tcl +++ b/bwidget-1.9.7/widget.tcl @@ -1487,11 +1487,67 @@ proc Widget::traverseTo { w } { } +# Widget::which -- +# +# Retrieve a fully qualified variable name for the specified option or +# widget variable. +# +# If the option is not one for which a variable exists, throw an error +# (ie, those options that map directly to widget options). +# +# For widget variables, return the fully qualified name even if the +# variable had not been previously set, in order to allow adding variable +# traces prior to their creation. +# +# Arguments: +# path megawidget to get an option var for. +# type either -option or -variable. +# name name of the option or widget variable. +# +# Results: +# Fully qualified name of the variable for the option or the widget +# variable. +# +proc Widget::which {path args} { + switch -- [llength $args] { + 1 { + set type -option; + set name [lindex $args 0]; + } + 2 { + set type [lindex $args 0]; + set name [lindex $args 1]; + } + default { + return -code error "incorrect number of arguments"; + } + } + + variable _class; + set class $_class($path); + + switch -- $type { + -option { + upvar 0 ${class}::$path:opt pathopt; + + if { ![info exists pathopt($option)] } { + error "unable to find variable for option \"$option\""; + } + + return ::Widget::${class}::${path}:opt(${name}); + } + -variable { + return ${class}::${path}:${name}; + } + } +} + # Widget::varForOption -- # # Retrieve a fully qualified variable name for the option specified. # If the option is not one for which a variable exists, throw an error -# (ie, those options that map directly to widget options). +# (ie, those options that map directly to widget options). Superseded by +# Widget::which. # # Arguments: # path megawidget to get an option var for. @@ -1501,17 +1557,7 @@ proc Widget::traverseTo { w } { # varname name of the variable, fully qualified, suitable for tracing. proc Widget::varForOption {path option} { - variable _class - variable _optiontype - - set class $_class($path) - upvar 0 ${class}::$path:opt pathopt - - if { ![info exists pathopt($option)] } { - error "unable to find variable for option \"$option\"" - } - set varname "::Widget::${class}::$path:opt($option)" - return $varname + return [::Widget::which $path -option $option]; } # Widget::getVariable -- -- 1.9.2 | |||
User Comments: |
oehhar added on 2014-05-21 07:34:37:
Committed by checkin [97c7fd38ff]. I would appreciate documentation and a sample to test functionality. Thank you, Harald |