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
|