rename string tcl::string Object stringNow 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
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]