Ticket UUID: | 023a631b20827c15ae93cc69c20153bd76425ec6 | |||
Title: | Lower-cased namespaces not supported | |||
Type: | Patch | Version: | 1.9.8 | |
Submitter: | anonymous | Created on: | 2014-12-05 15:17:16 | |
Subsystem: | (unused) | Assigned To: | oehhar | |
Priority: | 5 Medium | Severity: | Important | |
Status: | Closed | Last Modified: | 2015-03-18 13:18:52 | |
Resolution: | Accepted | Closed By: | oehhar | |
Closed on: | 2015-03-18 13:18:52 | |||
Description: |
BWidget codebase assumes that megawidget's code exists in a namespace named exactly like the class. This forbids having megawidget code in lower-cased namespaces, as widget classes must be upper-case in order to avoid confusing the option database. The following patch adds a new option -namespace to Widget::define, allowing specifying the namespace where widget code lives, when it is different from the class name. The widget dispatcher and the use procedure are now created in that namespace as well. Compatibility is maintained with BWidget's lazy-loading (widget are not defined when invoking their use procedure). ~~~ diff --git i/src/bwidget-1.9.8/BWman/Widget.html w/src/bwidget-1.9.8/BWman/Widget.html index c0560e8..27b274c 100644 --- i/src/bwidget-1.9.8/BWman/Widget.html +++ w/src/bwidget-1.9.8/BWman/Widget.html @@ -337,6 +337,9 @@ string defining the set. <li><i>class</i> is the name of the new widget class.</li> <li><i>filename</i> is the name of the file (without extension) in the BWidget distribution that defines this class.</li> + <li><i>?-classonly?</i> If present, the class is not setup.</li> + <li><i>?-namespace ns?</i> The namespace where the widget's procedures live + in; defaults to the class name.</li> </ul> <p> @@ -346,14 +349,14 @@ string defining the set. </p> <p> - This command does several things to setup the new class. First, it - creates an alias in the global namespace for the name of the class - that points to the class's ::create subcommand. Second, it defines - a ::use subcommand for the class which other classes can use to load - this class on the fly. Lastly, it creates a default binding to the - <Destroy> event for the class that calls Widget::destroy on - the path. This is the default setup for almost all widgets in the - BWidget package. + If <i>-classonly</i> option is not given this command does several things to + setup the new class. First, it creates an alias in the global namespace for + the name of the class that points to the class's ::create subcommand. + Second, it defines a ::use subcommand for the class which other classes can + use to load this class on the fly. Lastly, it creates a default binding to + the <Destroy> event for the class that calls Widget::destroy on the + path. This is the default setup for almost all widgets in the BWidget + package. </p> </DD></DL> diff --git i/src/bwidget-1.9.8/widget.tcl w/src/bwidget-1.9.8/widget.tcl index 4409018..7edb114 100644 --- i/src/bwidget-1.9.8/widget.tcl +++ w/src/bwidget-1.9.8/widget.tcl @@ -402,29 +402,81 @@ proc Widget::declare { class optlist } { } +# ---------------------------------------------------------------------------- +# Command Widget::define +# Declares a new class and loads its dependencies. +# +# Arguments: +# class megawidget class +# filename file where the class resides +# options The following options are supported: +# -classonly Prevents megawidget setup: creation of +# megawidget alias, binding of the +# <Destroy> event and stubbing of the +# 'use' procedure. +# -namespace ns Indicate the namespace where the +# megawidget's procedures reside. Defaults +# to ::${class}. +# dependencies classes the class being defined depends on. +# +# ---------------------------------------------------------------------------- proc Widget::define { class filename args } { variable ::BWidget::use + set classonly 0; + set ns ::${class}; + for {set i 0; set n [llength $args]} {$i < $n} {incr i} { + set option [lindex $args $i]; + switch -- $option { + -classonly { + set classonly 1; + } + -namespace { + incr i; + set ns [lindex $args $i]; + } + default { + # stop processing options + break; + } + } + } + set args [lrange $args $i end] + set use($class) $args set use($class,file) $filename + set use($class,namespace) $ns; lappend use(classes) $class - if {[set x [lsearch -exact $args "-classonly"]] > -1} { - set args [lreplace $args $x $x] - } else { - interp alias {} ::${class} {} ${class}::create - proc ::${class}::use {} {} - + if {!$classonly} { + interp alias {} ${ns} {} ${ns}::create + proc ${ns}::use {} {} bind $class <Destroy> [list Widget::destroy %W] } - foreach class $args { ${class}::use } + foreach dep $args { + if {![info exists use(${dep},namespace)]} { + # Lazy-loaded modules have are not yet loaded (actually that seems to be + # the whole point of this 'use' mechanism.) so they have not configured + # a namespace. Use namespace=class convention. Note that the class MUST + # not be prefixed by ::. + ${dep}::use; + } else { + $use(${dep},namespace)::use; + } + } } proc Widget::create { class path {rename 1} } { if {$rename} { rename $path ::$path:cmd } + + variable ::BWidget::use; + set ns [expr {[info exists use(${class},namespace)] + ? $use(${class},namespace) + : $class}]; + proc ::$path { cmd args } \ - [subst {return \[eval \[linsert \$args 0 ${class}::\$cmd [list $path]\]\]}] + [subst {return \[eval \[linsert \$args 0 ${ns}::\$cmd [list $path]\]\]}] return $path } ~~~ MfG Adrián Medraño Calvo | |||
User Comments: |
oehhar added on 2015-03-18 13:18:52:
(text/x-fossil-wiki)
Thank you for the patch. Included in checkin [3b6bda131c]. Ticket closed. Thanks, Harald anonymous (claiming to be Adrián Medraño Calvo) added on 2015-03-12 08:35:57: Fix variable cleanup and make sure the configured namespaces exist. ~~~ diff --git a/src/bwidget-1.9.8/widget.tcl b/src/bwidget-1.9.8/widget.tcl index 7579365..c91bea7 100644 --- a/src/bwidget-1.9.8/widget.tcl +++ b/src/bwidget-1.9.8/widget.tcl @@ -447,6 +447,11 @@ proc Widget::define { class filename args } { set use($class,namespace) $ns; lappend use(classes) $class + # Make sure the class description namespace exists. + namespace eval $class {} + # Make sure the megawidget namespace exists. + namespace eval $ns {}; + if {!$classonly} { interp alias {} ${ns} {} ${ns}::create proc ${ns}::use {} {} @@ -806,9 +811,15 @@ proc Widget::destroy { path } { if {![string equal [info commands $path] ""]} { rename $path "" } - ## Unset any variables used in this widget. - set ns ::BWidget::use(${class},namespace); - foreach var [info vars ${ns}::${path}:*] { unset $var } + # Unset any variables used in this widget. + # Guard, as some internal classes (Bitmap, LabelEntry, ListBox::Item, + # NoteBook::Page, PanedWindow::Pane, ScrollableFrame, ScrollableFrame, + # ScrollableFrame, Tree::Node, Wizard::Branch, Wizard::Step, Wizard::Widget) + # are declared but not defined. + if {[info exists ::BWidget::use(${class},namespace)]} { + set ns $::BWidget::use(${class},namespace); + foreach var [info vars ${ns}::${path}:*] { unset $var } + } unset _class($path) } ~~~ anonymous (claiming to be Adrián Medraño Calvo) added on 2014-12-06 11:22:57: The previous patch failed to use the specified namespace for instance variables. ~~~ diff --git a/src/bwidget-1.9.8/widget.tcl b/src/bwidget-1.9.8/widget.tcl index 7edb114..7579365 100644 --- a/src/bwidget-1.9.8/widget.tcl +++ b/src/bwidget-1.9.8/widget.tcl @@ -807,7 +807,8 @@ proc Widget::destroy { path } { if {![string equal [info commands $path] ""]} { rename $path "" } ## Unset any variables used in this widget. - foreach var [info vars ::${class}::$path:*] { unset $var } + set ns ::BWidget::use(${class},namespace); + foreach var [info vars ${ns}::${path}:*] { unset $var } unset _class($path) } @@ -1572,7 +1573,8 @@ proc Widget::which {path args} { return ::Widget::${class}::${path}:opt(${name}); } -variable { - return ${class}::${path}:${name}; + set ns $::BWidget::use(${class},namespace); + return ${ns}::${path}:${name}; } } } @@ -1610,8 +1612,9 @@ proc Widget::varForOption {path option} { proc Widget::getVariable { path varName {newVarName ""} } { variable _class set class $_class($path) + set ns $::BWidget::use(${class},namespace); if {![string length $newVarName]} { set newVarName $varName } - uplevel 1 [list ::upvar \#0 ${class}::$path:$varName $newVarName] + uplevel 1 [list ::upvar \#0 ${ns}::${path}:${varName} $newVarName] } # Widget::options -- ~~~ anonymous (claiming to be Adrián Medraño Calvo) added on 2014-12-05 16:02:56: There are missing bits in the above patch, will get back to it soon. |