From 4255d54c254a5f49a19017a3071b8d7ff35e70e9 Mon Sep 17 00:00:00 2001 From: Steve Bennett Date: Thu, 1 Dec 2011 14:32:09 +1000 Subject: 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 --- README.ensemble | 50 ++++++++++++++++++++++++++++++++++ auto.def | 1 + ensemble.tcl | 36 +++++++++++++++++++++++++ jim-namespace.c | 4 +-- nshelper.tcl | 14 ++++++++++ tests/ensemble.test | 47 ++++++++++++++++++++++++++++++++ tests/nsensemble.test | 75 +++++++++++++++++++++++++++++++++++++++++++++++++++ 7 files changed, 225 insertions(+), 2 deletions(-) create mode 100644 README.ensemble create mode 100644 ensemble.tcl create mode 100644 tests/ensemble.test create mode 100644 tests/nsensemble.test diff --git a/README.ensemble b/README.ensemble new file mode 100644 index 0000000..1506565 --- /dev/null +++ b/README.ensemble @@ -0,0 +1,50 @@ +An ensemble is a single command that can dispatch subcommands +to other commands. + +For example [string] is a built-in ensemble. + +The ensemble command allows an ensemble command to be created +that redirects to other commands. + +Create an ensemble by having multiple commands that all share +the same prefix. For example: + +proc {test open} {name} { ... } +proc {test close} {handle} { ... } +proc {test show} {handle} { ... } + +Then simply: + +ensemble test + +Now a new command, test, is created that will invoke the other commands +based on the first argument. For example: + +set h [test open file.txt] +test show $h +test close $h + +By default ensemble expects the commands to be named " ". If another +prefix is used, this can be specified with the -automap option. e.g. + +ensemble test -automap test. + +This could be used if the commands were named test.open, test.close, test.show + +Note that ensembles are dynamic, not fixed at the point of creation. +This means, for example, that we can can create a new commands, "test reverse" +after the ensemble has been created and it can still be invoked as test reverse ... + +It is easy to create an ensemble for commands in a namespace by simply using +-automap :: however for compatibility with Tcl, 'namespace ensemble create' is provided +that does with when invoked within a namespace. e.g. + +namespace eval test { + namespace ensemble create + + proc open {name} { ... } + proc close {handle} { ... } + proc show {handle} { ... } +} + +test open file.txt diff --git a/auto.def b/auto.def index 0ea71b3..fef620d 100644 --- a/auto.def +++ b/auto.def @@ -65,6 +65,7 @@ foreach {mod attrs help} { array {} {Tcl-compatible array command} binary { tcl optional } {Tcl-compatible binary command} clock {} {Tcl-compatible clock command} + ensemble { optional tcl } {Ensemble command} eventloop { static } {after, vwait, update} exec { static } {Tcl-compatible exec command} file {} {Tcl-compatible file command} 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 + } +} diff --git a/jim-namespace.c b/jim-namespace.c index 87c4dc8..73c4352 100644 --- a/jim-namespace.c +++ b/jim-namespace.c @@ -201,13 +201,13 @@ static int JimNamespaceCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) int option; static const char * const options[] = { "eval", "current", "canonical", "qualifiers", "parent", "tail", "delete", - "origin", "code", "inscope", "import", "export", + "origin", "code", "inscope", "ensemble", "import", "export", "which", "upvar", NULL }; enum { OPT_EVAL, OPT_CURRENT, OPT_CANONICAL, OPT_QUALIFIERS, OPT_PARENT, OPT_TAIL, OPT_DELETE, - OPT_ORIGIN, OPT_CODE, OPT_INSCOPE, OPT_IMPORT, OPT_EXPORT, + OPT_ORIGIN, OPT_CODE, OPT_INSCOPE, OPT_ENSEMBLE, OPT_IMPORT, OPT_EXPORT, OPT_WHICH, OPT_UPVAR, }; diff --git a/nshelper.tcl b/nshelper.tcl index 9e617b7..499022e 100644 --- a/nshelper.tcl +++ b/nshelper.tcl @@ -143,3 +143,17 @@ proc {namespace upvar} {ns args} { } tailcall {*}$script } + +proc {namespace ensemble} {subcommand args} { + if {$subcommand ne "create"} { + return -code error "only \[namespace ensemble create\] is supported" + } + set ns [uplevel 1 namespace canon] + set cmd $ns + if {$ns eq ""} { + return -code error "namespace ensemble create: must be called within a namespace" + } + + # Create the mapping + ensemble $cmd -automap ${ns}:: {*}$args +} diff --git a/tests/ensemble.test b/tests/ensemble.test new file mode 100644 index 0000000..507cd20 --- /dev/null +++ b/tests/ensemble.test @@ -0,0 +1,47 @@ +source [file dirname [info script]]/testing.tcl + +needs constraint jim +needs package ensemble + +# Let's create some procs for our ensembles + +proc {foo a} {x} { + incr x +} +proc {foo b} {y} { + incr y 2 +} +test ensemble-1.1 {Basic ensemble} { + ensemble foo + foo a 5 +} 6 + +test ensemble-1.2 {ensemble -commands} { + foo -commands +} {a b} + +test ensemble-1.3 {ensemble -help} { + foo -help +} {Usage: "foo command ... ", where command is one of: a, b} + +test ensemble-1.4 {ensemble with invalid subcommand} -body { + foo c x +} -returnCodes error -result {invalid command name "foo c"} + +test ensemble-1.5 {ensemble add new commands} { + proc {foo c} {z} { + append z @ + } + foo c x +} {x@} + +test ensemble-1.6 {ensemble remove mapping} -body { + rename {foo a} "" + foo a 4 +} -returnCodes error -result {invalid command name "foo a"} + +test ensemble-1.7 {ensemble updated -commands} { + foo -commands +} {b c} + +testreport diff --git a/tests/nsensemble.test b/tests/nsensemble.test new file mode 100644 index 0000000..9306167 --- /dev/null +++ b/tests/nsensemble.test @@ -0,0 +1,75 @@ +source [file dirname [info script]]/testing.tcl + +needs constraint jim +needs cmd ensemble +needs cmd namespace +testConstraint package-ensemble [expr {"ensemble" in [package list]}] + +# Let's create some procs for our ensemble +namespace eval foo { + proc a {x} { + incr x + } + proc b {y} { + incr y 2 + } + proc c {z} { + append z @ + } +} + +test nsensemble-1.0 {Create ensemble outside namespace} -body { + # Create an ensemble for our namespace + namespace ensemble create +} -returnCodes error -result {namespace ensemble create: must be called within a namespace} + +test nsensemble-1.1 {Basic namespace ensemble} { + # Create an ensemble for our namespace + namespace eval foo { + namespace ensemble create + } + # And invoke a method + foo a 5 +} 6 + +test nsensemble-1.2 {namespace ensemble -commands} package-ensemble { + foo -commands +} {a b c} + +test nsensemble-1.3 {namespace ensemble -help} package-ensemble { + foo -help +} {Usage: "foo command ... ", where command is one of: a, b, c} + +test nsensemble-1.4 {namespace ensemble with invalid subcommand} -constraints package-ensemble -body { + foo d x +} -returnCodes error -result {invalid command name "foo::d"} + +# Now a nested namespace ensemble +namespace eval foo { + namespace eval bar { + proc a {x} { + incr x 10 + } + proc b {y} { + incr y 20 + } + proc c {z} { + append z % + } + namespace ensemble create + } +} + +test nsensemble-2.1 {Nested namespace ensemble} { + # And invoke a method + foo::bar a 5 +} 15 + +test nsensemble-2.2 {Nested namespace ensemble from namespace} { + # And invoke a method + namespace eval foo { + bar a 6 + } +} 16 + +testreport -- cgit v1.1