Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Something cute and fuzzy

10 views
Skip to first unread message

Mike Rogers

unread,
Aug 22, 2001, 2:36:08 PM8/22/01
to
Here's a cute script that adds inheritance to namespaces. It's kinda
neat if you want a very limited oo tcl, but you want all the existing
tools you use to work (i.e. your syntax hilighting editors,
application builders, debuggers, etc know about tcl namespaces, but
not about itcl, otcl, xotcl, tcl++, tclpp, stooop, etc.). The script
needs a lot of work (need to fix namespace deletion,
'info body ns::method' doesn't give you what you expect, doesn't work
for
tcl 8.2 etc.).

Anyway, its just something to play around with. Here's a sample:

namespace eval animal {
variable sound "silence..."
proc sayIt {what} {
variable sound
puts "[namespace current]: '$what' sounds like '$sound'"
}
}
namespace eval dog {
inherits ::animal
variable sound "ruff, ruff"
}
namespace eval cat {
inherits ::animal
variable sound "meeeeeow"
}

> animal::sayIt hello
::animal: 'hello' sounds like 'silence...'
> dog::sayIt hello
::dog: 'hello' sounds like 'ruff, ruff'
> cat::sayIt hello
::cat: 'hello' sounds like 'meeeeeow'


And here's the script:
------------------------

catch {namespace delete spoons}
namespace eval spoons {
proc proc {name args body} {
if {[uplevel 1 namespace current] == "::"} {
_proc $name $args $body
return
}
set methodBody "uplevel 1 \{$body \}"
_proc ::methods::${name} $args $methodBody
set script "_proc $name \{$args\} \{\n ::methods::$name $args\n\}"
uplevel 1 $script
}

::proc inherits {supers} {
foreach i $supers {
foreach v [info vars ${i}::*] {
set var [namespace tail $v]
if {[array exists $v]} {
uplevel array set $var [array get $v]
} else {
if {[catch {set val [set $v]}]} {
uplevel variable $var
} else {
uplevel variable $var $val
}
}
}
foreach p [info procs ${i}::*] {
set thisProc [namespace tail $p]
set thisArgs [info args $p]
set thisBody [info body $p]
uplevel _proc $thisProc \{$thisArgs\} \{$thisBody\}
}
}
}

namespace export proc
namespace export inherits
}
if {[info command _proc] == "_proc"} {
rename proc ""
} else {
rename proc _proc
}
namespace import ::spoons::proc
namespace import ::spoons::inherits

miguel sofer

unread,
Aug 22, 2001, 4:32:44 PM8/22/01
to
Mike Rogers wrote:

> Here's a cute script that adds inheritance to namespaces. It's kinda
> neat if you want a very limited oo tcl, but you want all the existing
> tools you use to work (i.e. your syntax hilighting editors,
> application builders, debuggers, etc know about tcl namespaces, but
> not about itcl, otcl, xotcl, tcl++, tclpp, stooop, etc.). The script
> needs a lot of work (need to fix namespace deletion,
> 'info body ns::method' doesn't give you what you expect, doesn't work
> for
> tcl 8.2 etc.).

Interesting; it belongs in the wiki, I'd say!

Miguel

0 new messages