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>

7 files changed, 225 insertions, 2 deletions

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 "<name> ". 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 <ns>:: 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