diff options
author | Steve Bennett <steveb@workware.net.au> | 2011-12-01 14:32:09 +1000 |
---|---|---|
committer | Steve Bennett <steveb@workware.net.au> | 2023-02-13 10:52:21 +1000 |
commit | 4255d54c254a5f49a19017a3071b8d7ff35e70e9 (patch) | |
tree | 3f0a7d263850cb461321d76b6ca5f84a286f7322 /ensemble.tcl | |
parent | d295fb1b6124575793add4b95860fabd1539a099 (diff) | |
download | jimtcl-4255d54c254a5f49a19017a3071b8d7ff35e70e9.zip jimtcl-4255d54c254a5f49a19017a3071b8d7ff35e70e9.tar.gz jimtcl-4255d54c254a5f49a19017a3071b8d7ff35e70e9.tar.bz2 |
ensemble: Add a simple ensemble command
Uses a prefix to automatically map from subcommand to
implementation.
Includes support for namespace ensemble
Signed-off-by: Steve Bennett <steveb@workware.net.au>
Diffstat (limited to 'ensemble.tcl')
-rw-r--r-- | ensemble.tcl | 36 |
1 files changed, 36 insertions, 0 deletions
diff --git a/ensemble.tcl b/ensemble.tcl new file mode 100644 index 0000000..9e87809 --- /dev/null +++ b/ensemble.tcl @@ -0,0 +1,36 @@ +# Implement the ensemble command + +proc ensemble {command args} { + set autoprefix "$command " + set badopts "should be \"ensemble command ?-automap prefix?\"" + if {[llength $args] % 2 != 0} { + return -code error "wrong # args: $badopts" + } + foreach {opt value} $args { + switch -- $opt { + -automap { set autoprefix $value } + default { return -code error "wrong # args: $badopts" } + } + } + proc $command {subcmd args} {autoprefix {mapping {}}} { + if {![dict exists $mapping $subcmd]} { + # Not an exact match, so check for specials, then lookup normally + if {$subcmd in {-commands -help}} { + # Need to remove $autoprefix from the front of these + set prefixlen [string length $autoprefix] + set subcmds [lmap p [lsort [info commands $autoprefix*]] { + string range $p $prefixlen end + }] + if {$subcmd eq "-commands"} { + return $subcmds + } + set command [lindex [info level 0] 0] + return "Usage: \"$command command ... \", where command is one of: [join $subcmds ", "]" + } + # cache the mapping + dict set mapping $subcmd ${autoprefix}$subcmd + } + # tailcall here we don't add an extra stack frame, e.g. for uplevel + tailcall [dict get $mapping $subcmd] {*}$args + } +} |