add dump command to shell to start enabling debugging

[scpubgit/DKit.git] / bin / dx-shell

diff --git a/bin/dx-shell b/bin/dx-shell
index 5a61588..6848ed6 100644 (file)
--- a/bin/dx-shell
+++ b/bin/dx-shell
@@ -6,6 +6,7 @@ use DX::Solver;
 use DX::Lib::FS;
 use Term::ReadLine;
 use Devel::Dwarn;
+use Sub::Quote;
 
 my $solver = DX::Solver->new(observation_policy => sub { 1 });
 
@@ -35,9 +36,14 @@ sub do_query {
 sub expand_def {
   my ($vars, $body) = @_;
   my @varnames = $split->($vars);
+  return (\@varnames, expand_body($body));
+}
+
+sub expand_body {
+  my ($body) = @_;
   local our @Body_Parts;
   $tcl->Eval($body);
-  return (\@varnames, @Body_Parts);
+  return @Body_Parts;
 }
 
 $tcl->CreateCommand(query => sub {
@@ -57,6 +63,12 @@ $tcl->CreateCommand(run => sub {
   return;
 });
 
+$tcl->CreateCommand(dump => sub {
+  my (undef, undef, undef, $to_dump) = @_;
+  my $filter = quote_sub($to_dump);
+  Dwarn(map $filter->($_), @res);
+});
+
 sub mangle_args {
   my @args = @_;
   map { $_ =~ /^'(.*)'$/ ? \do { my $x = $1 } : $_ } @args;
@@ -85,6 +97,14 @@ $tcl->CreateCommand(exists => sub {
   push our @Body_Parts, [ exists => expand_def($vars, $body) ];
   return;
 });
+
+$tcl->CreateCommand(foreach => sub {
+  my (undef, undef, undef, $var, $body, $each_body) = @_;
+  push our @Body_Parts, [
+    foreach => $var => map [ expand_body($_) ], $body, $each_body
+  ];
+  return;
+});
   
 #$tcl->Eval(q{query D {directory_at D 't'; mode D '0755'; }});