XOTcl Objects as Tcl Commands with subcommands

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 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)

HD: I can't get this to work. Once I give the command "rename string tcl::string" (or "rename string tcl::arbitrary_name"), I keep getting:

 self-referential recursion in "unknown" for command "string"

MJ - My guess is that you are trying this in a wish console. Note that the wish shell uses string commands when displaying for instance the prompt. So after you type the rename command the string proc is not defined (you still need to define it further on). Wish will try to call string which is not defined, it will then call unknown to try to handle the string command. Unknown however uses string again leading to the recursion. The only way this will work is to:

• Do it in a tclsh
• Store it in a file and do a [source $file] from wish

HD Got it working, thanks. Also I want to point out a problem I had in the hopes that it will save someone else a lot of time. I was cutting and pasting examples from the XOTcl tutorial PDF document, and finding that a lot of them didn't seem to work. The problem was that there are several characters that display as '-' in both the PDF and the Tcl window but are non-ascii. After I pasted the examples to a text editor and replaced all the minus signs, the examples worked.

MJ - Another implementation I already had of the same idea (needs 8.5 because of use of {*}).

 package require XOTcl

 namespace import ::xotcl::*

 # wrap all procs that allow subcommands in a XOTcl object and hide the original
 # this has the advantage that $proc info commands can display subcommands

 interp alias {} dotcl {} interp invokehidden {}

 set procs_to_hide {file string package info namespace}

 foreach proc $procs_to_hide {
   interp hide {} $proc
   Object create $proc
   $proc set name $proc
   # define unknown in case we miss subcommands
   $proc proc unknown {args} {
     puts "XOTcl wrapper for '[my set name]' called with args: $args"
     return [dotcl [my set name] {*}$args]
   }
 }

 file proc join {args} {
   return [dotcl file join {*}$args]
 }

 puts [file join a b c]
 puts [file info commands]