X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=bin%2Fdx-shell;h=572c9d218794b9ba257a9cb60f9836af4adb65ae;hb=97c0c46e84692374cb6aacede35707e09903c1b7;hp=5a61588e2d8a642977d8309dcb25fe02422c477f;hpb=f5a02c91b10ef340dce1e1dacee0a761254f4d80;p=scpubgit%2FDKit.git diff --git a/bin/dx-shell b/bin/dx-shell index 5a61588..572c9d2 100644 --- a/bin/dx-shell +++ b/bin/dx-shell @@ -35,9 +35,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 { @@ -85,6 +90,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'; }});