X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=bin%2Fdx-shell;h=725fc103f081fc84324538f6efda0928380638b7;hb=7ca660cb75c4248a653dd68036227e309faaac9b;hp=186598249f375a32859e4175f9064eb83b7f31df;hpb=9854aea02301c4a610b98f4ec3ee3bc749e91d45;p=scpubgit%2FDKit.git

diff --git a/bin/dx-shell b/bin/dx-shell
index 1865982..725fc10 100644
--- a/bin/dx-shell
+++ b/bin/dx-shell
@@ -23,14 +23,22 @@ my $tcl = Tcl->new;
 
 my $split = $tcl->curry::weak::SplitList;
 
-my (@res, @last_q);
+my ($r, $res, @last_q);
 
-sub do_query {
-  @res = $solver->query(@last_q)->results;
-  Dwarn([ map {
+my $last_mode;
+
+sub show {
+  $r = ($res->isa('DX::Result') ? $res : $res->next);
+  unless ($r) { warn "false\n"; return; }
+  Dwarn(map {
     my @act = $_->actions;
     ((@act ? \@act : ()), $_->all_values);
-  } @res ]);
+  } $r);
+}
+
+sub do_query {
+  $res = $solver->$last_mode(@last_q);
+  show();
 }
 
 sub expand_def {
@@ -40,23 +48,29 @@ sub expand_def {
 }
 
 sub expand_body {
-  my ($body) = @_;
+  my (@body) = @_;
   local our @Body_Parts;
-  $tcl->Eval($body);
+  $tcl->Eval(@body);
   return @Body_Parts;
 }
 
-$tcl->CreateCommand(query => sub {
-  my (undef, undef, undef, $body) = @_;
-  @last_q = expand_body($body);
+sub q_command {
+  my ($this_mode, undef, undef, undef, $body) = @_;
+  $last_mode = $this_mode;
+  if ($body) {
+    @last_q = expand_body($body);
+  }
   do_query();
   return;
-});
+}
+
+$tcl->CreateCommand('?' => sub { q_command(query => @_) });
+$tcl->CreateCommand('?!' => sub { q_command(solve => @_) });
+$tcl->CreateCommand('!?' => sub { q_command(solve => @_) });
+$tcl->CreateCommand('!' => sub { q_command(ensure => @_) });
 
 $tcl->CreateCommand(run => sub {
-  foreach my $ind ($res[0]->independent_actions) {
-    my $cl = ref($ind);
-    warn +(split('::', $cl))[-1]."\n";
+  foreach my $ind ($r->independent_actions) {
     $solver->run_action($ind);
   }
   do_query();
@@ -66,7 +80,7 @@ $tcl->CreateCommand(run => sub {
 $tcl->CreateCommand(dump => sub {
   my (undef, undef, undef, $to_dump) = @_;
   my $filter = quote_sub($to_dump);
-  Dwarn(map $filter->($_), @res);
+  Dwarn($filter->($r));
 });
 
 sub mangle_args {
@@ -99,6 +113,14 @@ $tcl->CreateCommand(foreach => sub {
   ];
   return;
 });
+
+$tcl->CreateCommand(findall => sub {
+  my (undef, undef, undef, $coll_var, $name_var, $body) = @_;
+  push our @Body_Parts, [
+    findall => $coll_var => $name_var => expand_body($body)
+  ];
+  return;
+});
   
 #$tcl->Eval(q{query D {directory_at D 't'; mode D '0755'; }});