Attachment "namespace-snit.diff" to
ticket [1886636fff]
added by
hobbs
2008-02-05 09:56:28.
Index: modules/snit/main2.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/snit/main2.tcl,v
retrieving revision 1.13
diff -u -r1.13 main2.tcl
--- modules/snit/main2.tcl 4 Jul 2007 01:15:00 -0000 1.13
+++ modules/snit/main2.tcl 5 Feb 2008 02:55:49 -0000
@@ -28,6 +28,7 @@
namespace eval ::snit:: {
variable reservedArgs {type selfns win self}
+ variable snitCompileCmd "namespace" ; # namespace | interp
# Widget classes which can be hulls (must have -class)
variable hulltypes {
@@ -343,46 +344,60 @@
proc ::snit::Comp.Init {} {
variable compiler
variable reservedwords
+ variable snitCompileCmd
if {$compiler eq ""} {
+ set useNamespace [string equal "namespace" $snitCompileCmd]
# Create the compiler's interpreter
- set compiler [interp create]
+ if {$useNamespace} {
+ set compiler ::snit::compiler
+ } else {
+ set compiler [interp create]
+ }
- # Initialize the interpreter
- $compiler eval {
- # Load package information
- # TBD: see if this can be moved outside.
- # @mdgen NODEP: ::snit::__does_not_exist__
- catch {package require ::snit::__does_not_exist__}
-
- # Protect some Tcl commands our type definitions
- # will shadow.
- rename proc _proc
- rename variable _variable
- }
+ if {$useNamespace} {
+ # Get the list of reserved words
+ set reservedwords [info commands]
+ }
# Define compilation aliases.
- $compiler alias pragma ::snit::Comp.statement.pragma
- $compiler alias widgetclass ::snit::Comp.statement.widgetclass
- $compiler alias hulltype ::snit::Comp.statement.hulltype
- $compiler alias constructor ::snit::Comp.statement.constructor
- $compiler alias destructor ::snit::Comp.statement.destructor
- $compiler alias option ::snit::Comp.statement.option
- $compiler alias oncget ::snit::Comp.statement.oncget
- $compiler alias onconfigure ::snit::Comp.statement.onconfigure
- $compiler alias method ::snit::Comp.statement.method
- $compiler alias typemethod ::snit::Comp.statement.typemethod
- $compiler alias typeconstructor ::snit::Comp.statement.typeconstructor
- $compiler alias proc ::snit::Comp.statement.proc
- $compiler alias typevariable ::snit::Comp.statement.typevariable
- $compiler alias variable ::snit::Comp.statement.variable
- $compiler alias typecomponent ::snit::Comp.statement.typecomponent
- $compiler alias component ::snit::Comp.statement.component
- $compiler alias delegate ::snit::Comp.statement.delegate
- $compiler alias expose ::snit::Comp.statement.expose
+ foreach {cmd alias} {
+ _proc ::proc
+ _variable ::variable
+ pragma ::snit::Comp.statement.pragma
+ widgetclass ::snit::Comp.statement.widgetclass
+ hulltype ::snit::Comp.statement.hulltype
+ constructor ::snit::Comp.statement.constructor
+ destructor ::snit::Comp.statement.destructor
+ option ::snit::Comp.statement.option
+ oncget ::snit::Comp.statement.oncget
+ onconfigure ::snit::Comp.statement.onconfigure
+ method ::snit::Comp.statement.method
+ typemethod ::snit::Comp.statement.typemethod
+ typeconstructor ::snit::Comp.statement.typeconstructor
+ proc ::snit::Comp.statement.proc
+ typevariable ::snit::Comp.statement.typevariable
+ variable ::snit::Comp.statement.variable
+ typecomponent ::snit::Comp.statement.typecomponent
+ component ::snit::Comp.statement.component
+ delegate ::snit::Comp.statement.delegate
+ expose ::snit::Comp.statement.expose
+ } {
+ if {$useNamespace} {
+ interp alias {} ${compiler}::$cmd {} $alias
+ lappend reservedwords $cmd
+ } else { # interp
+ if {[string match _* $cmd]} {
+ rename $alias $cmd
+ } else {
+ $compiler alias $cmd $alias
+ }
+ }
+ }
- # Get the list of reserved words
- set reservedwords [$compiler eval {info commands}]
+ if {!$useNamespace} {
+ set reservedwords [$compiler eval {info commands}]
+ }
}
}
@@ -399,6 +414,7 @@
variable simpleTypeProc
variable compile
variable compiler
+ variable snitCompileCmd
variable methodInfo
variable typemethodInfo
@@ -454,7 +470,7 @@
set isWidgetAdaptor [string match widgetadaptor $which]
# NEXT, Evaluate the type's definition in the class interpreter.
- $compiler eval $body
+ $snitCompileCmd eval $compiler $body
# NEXT, Add the standard definitions
append compile(defs) \
@@ -1767,6 +1783,7 @@
# type definition statements, and thus can be used for meta-programming.
proc ::snit::macro {name arglist body} {
variable compiler
+ variable snitCompileCmd
variable reservedwords
# FIRST, make sure the compiler is defined.
@@ -1782,11 +1799,11 @@
set ns [namespace qualifiers $name]
if {$ns ne ""} {
- $compiler eval "namespace eval $ns {}"
+ $snitCompileCmd eval $compiler [list namespace eval $ns {}]
}
# NEXT, define the macro
- $compiler eval [list _proc $name $arglist $body]
+ $snitCompileCmd eval $compiler [list _proc $name $arglist $body]
}
#-----------------------------------------------------------------------
