This is an introductory example how to use XOTcl objects as tcl commands with subcommands (aka ensembles. This can be used for example to extend an existing tcl commands with additional or replaced functionality.
We use here the the tcl command "string" and extend it with the subcommands from Additional string functions.
In the first step we rename the original tcl command and define an XOTcl object with the same name.
rename string tcl::string Object string
Now we can define the new procs as object procs like in the following. These object procs can be used as subcommands.
string proc charsort { string } {
return [join [lsort [split $string {}] ] {} ]
}
string proc insert {string pos char} {
set original [string index $string $pos]
string replace $string $pos $pos $char$original
}
string proc letterspace s {
join [split $s ""] " "
}
string proc linbreak {s {width 80}} {
set res {}
while {[string length $s]>$width} {
set pos [string wordstart $s $width]
lappend res [string range $s 0 [expr {$pos-1}]]
set s [string range $s $pos end]
}
lappend res $s
}
string proc revert s {
set l [string length $s]
set res ""
while {$l} {append res [tcl::string index $s [incr l -1]]}
set res
}Finally we define an unknown method which is called when none of the above procs are specified as subcommands. First, unknown tries to delegate the command to the saved tcl command. If an error occurs in the saved command, we parse the error message containing the subcommands from the original tcl command. We use these and add the object procs (except unknown), which can be obtained via introspection (my info procs).
string proc unknown {subcmd args} {
if {[catch {set r [eval tcl::string $subcmd $args]} msg]} {
regexp {"([^\"]+)".*must be (.*) or (.*)$} $msg _ option sub1 sub2
set tclcmds [tcl::string map {"," ""} "$sub1 $sub2"]
set procs [my info procs]
set i [lsearch $procs unknown]
error "Unknown subcommand '$option', valid are [join [lsort [concat [lreplace $procs $i $i] [split $tclcmds]]] {, }]"
}
return $r
}
Finally, we do some tests using proc ? from RS.
proc ? {cmd exp} {
if [catch {uplevel 1 $cmd} res] {
error $::errorInfo
} elseif {$res ne $exp} {
puts "$cmd->$res, not $exp"
}
}
? {string first bc abcd} 1
? {string linbreak "a be cd de eff" 5} "{a be } {cd de} { eff}"
? {string charsort "abrakadabra"} "aaaaabbdkrr"
? {string insert hello 1 abc} "habcello"
? {string letterspace "hello world"} "h e l l o w o r l d"
? {string revert "hello world"} "dlrow olleh"
? {string something abcd} ?Note that the command can be incrementally extended with new subcommands. It is as well possible to intercept subcommands by using XOTcls interceptors (mixin classes and filter methods).
-gustaf neumann (GN)