# this code creates 3 namespaces: {win32}, {win32 media} and {string}
proc {win32 ping} {host} {
puts "Sending ping to host $host"
}
proc {win32} {args} {
set namespace [lindex [info level 0] 0]
if { [llength $args]==0 } {
puts "[info procs [concat $namespace *]]"
} else {
[concat $namespace [lindex $args 0]] {*}[lrange $args 1 end]
}
}
proc {win32 media play} {song} {
puts "playing song $song"
}
proc {win32 media beep} {length} {
puts "beeping for $length"
}
proc {win32 media} {args} {
set namespace [lindex [info level 0] 0]
if { [llength $args]==0 } {
puts "[info procs [concat $namespace *]]"
} else {
"$namespace [lindex $args 0]" {*}[lrange $args 1 end]
}
}
# do some tests with string
rename string _string
proc {string bytelength} {args} {
_string bytelength {*}$args
}
proc {string compare} {args} {
_string compare {*}$args
}
proc {string equal} {args} {
_string equal {*}$args
}
proc {string first} {args} {
_string first {*}$args
}
proc {string index} {args} {
_string index {*}$args
}
proc {string is} {args} {
_string is {*}$args
}
proc {string last} {args} {
_string last {*}$args
}
proc {string length} {string} {
_string length $string
}
proc {string map} {args} {
_string map {*}$args
}
proc {string match} {args} {
_string match {*}$args
}
#range repeat replace tolower toupper totitle trim trimleft trimright wordend wordstart
proc {string} {args} {
# puts "called string $args"
set namespace [lindex [info level 0] 0]
if { [llength $args]==0 } {
puts "[info procs [concat $namespace *]]"
} else {
"$namespace [lindex $args 0]" {*}[lrange $args 1 end]
}
}
puts [string length 12]
# show all commands in the win32 namespace
puts [win32]NEM: See also namespace ensemble command (added in 8.5) that layers similar functionality over existing namespaces. The main differences are that procs in an ensemble are created using traditional
proc foo::bar ...syntax rather than the
proc {foo bar} ...use above. Also calling a namespace ensemble with no arguments produces an error, rather than a list of commands in that namespace. I quite like the idea of producing a list of commands (perhaps it can be done with one of the namespace ensemble options?). Note that you could also extend the syntax of proc in a backwards compatible way to support the following: proc foo bar {args} { ... }This would then naturally extend to creating lambdas: set myfunc [proc {a b} { expr {$a + $b} }]MJ - Note that after some consideration executing a command to determine its subcommands/namespace doesn't seem like too bright of an idea, because you don't know upfront if there are any subcommands and therefore you might actually execute a command that doesn't need any parameters instead of a namespace. Imagine the surprise if an IDE gets the bright idea to find subcommands for the command {system hardisk format}. The way to resolve this is of course to only execute namespaces. Which quickly leads to subcommands that displays procs or namespaces and don't have any side-effects (like executing a command).escargo - I have become more fond of object systems where you can query an object to determine what methods it understands. This is just basic introspection. One of the early suggestions I made to Snit was that types and methods should be able to respond to info commands. In that view, a command should be able to respond to info commands (or info methods) with the appropriate responses.NEM - Yes, an info subcommand is also a good way to go. Conventions for such introspection could be formalised with, for instance Peter DeRijk's interface proposal.MJ - Below a more advanced version that offers other ways of introspection to prevent the problem I mentioned above. I agree with escargo that this is a first start in an OO system with introspection a la Ruby. I do like the easy way you can create nested namespaces though. This is done by redefining proc, which allows you to do something like:
proc { math arithmetic add } { x y } { expr {$x + $y}}This will create all intermediate namespaces and define the proc. proc {ns create} {namespace} {
variable ns
dict set ns $namespace 1
set create_proc [list proc $namespace {args}]
set create_proc [concat $create_proc { {
set namespace [lindex [info level 0] 0]
if { [llength $args]==0 } {
return [concat [ns procs $namespace] [ns children $namespace]]
} else {
"$namespace [lindex $args 0]" {*}[lrange $args 1 end]
}
}}
]
eval $create_proc
}
proc {ns exists} {namespace} {
if {[info proc $namespace]==""} {
return false
} else {
return true
}
}
# create the ns and root namespaces
{ns create} ns
{ns create} {}
proc {ns instproc} {namespace name args body} {
eval [list proc [concat $namespace $name] $args $body]
}
proc {ns instvar} {namespace name value} {
set var_name [concat $namespace $name]
variable $var_name
set $var_name $value
}
proc {ns procs} {namespace} {
set ns_procs ""
foreach ns_proc [info commands [concat $namespace *]] {
if {([llength $ns_proc] == [llength $namespace] + 1) } {
if {[ns is_namespace? $ns_proc ]} continue
lappend ns_procs $ns_proc
}
}
return $ns_procs
}
proc {ns vars} {namespace} {
set ns_vars ""
foreach ns_var [uplevel #0 "info vars {[concat $namespace *]}"] {
if {([llength $ns_var] == [llength $namespace] + 1) } {
lappend ns_vars $ns_var
}
}
return $ns_vars
}
proc {ns is_namespace?} {namespace} {
variable ns
dict exists $ns $namespace
}
proc {ns children} {namespace} {
set ns_children ""
foreach ns_child [info procs [concat $namespace *]] {
if {([llength $ns_child] == [llength $namespace] + 1) } {
if {![ns is_namespace? $ns_child]} continue
lappend ns_children $ns_child
}
}
return $ns_children
}
proc {ns parent} {namespace} {
lrange $namespace 0 end-1
}
# scaffolding is in place
# rename proc so that proc {a b c} {x y z} { ... }
# will create ns a {a b} and define c in {a b} as described in [1]
rename proc _proc
_proc proc {name args body} {
set name [string trim $name]
set namespace [lrange $name 0 end-1]
if {![ns exists $namespace] } {
# warning if the root namespace {} doesn't exist this will recurse infinitely
# puts "creating namespace $namespace"
ns create $namespace
}
_proc $name $args $body
} # example use twapi wrapped in subnamespaces
proc {ns use_with_twapi} {} {
package require twapi
# system functions
proc {twapi system abort_system_shutdown} {args} {
::twapi::abort_system_shutdown {*}$args
}
foreach proc {get_computer_netbios_name get_active_processor_mask} {
proc [list twapi system $proc] {} ::twapi::$proc
}
# sound functions
proc {twapi sound beep} {args} {
::twapi::beep {*}$args
}
}
# display all procs in the global namespace
puts [{}]
# display namespaces under the global namespace
puts [ns children {}]
# if you have twapi
ns use_with_twapi
puts [ns children {}]
# call a twapi command with the new syntax
twapi sound beep -type ok