1: I don`t know if this is Craft, or a hack, I DO know that 2: it comes in handy (For me, since I am not a complete master 3: of regular expressions (not until japhy's) book at least ;)) 4: 5: I am sure there is something like this out there, but I haven`t 6: bothered to look (sometimes it is just more fun to do something 7: yourself ;) 8: 9: What does it do ? 10: 11: It draws you a little Tk window, and allows you to enter a string 12: and let a RegEx loose on it. 13: Dynamically the result of the RegEx is shown, and updated, so you 14: can see exactly what the result is of a change in the RegEx, or the 15: string. 16: 17: TODO: 18: 19: - Do something about that UI! ;) 20: - Put an another eval in the function so $1..n are really 21: 1..n, instead of 1..5 ;) 22: - Support for @+ @- 23: - Clean up code ;) 24: - Loads of stuff 25: 26: Code will be updated soon, I hope ;) 27: 28: Update: Implemented List context feature, as suggested by Jepri 29: 30: The Code: 31: #!/usr/bin/perl -w 32: use strict; 33: use Tk; 34: 35: sub KeyPress; 36: 37: my $MW=MainWindow->new; 38: 39: my $AsList; 40: my %Border=qw(-relief raised); 41: my %Fill=qw(-fill both); 42: 43: my $Top =$MW->Frame->pack(-side=>'top'); 44: my $TopLeft =$Top->Frame(%Border)->pack(-side=>'left'); 45: my $TopRight =$Top->Frame(%Border)->pack(-side=>'left'); 46: 47: my $RegLabel=$TopLeft->Label(%Border,-text=>'RegExp')->pack(%Fill); 48: my $TextLabel=$TopLeft->Label(%Border,-text=>'Text')->pack(%Fill); 49: my $AsListBox=$Top->Checkbutton(-text=>'List context',-variable=>\$AsList,-command=>\&KeyPress)->pack(); 50: $Border{-bd}=1; 51: my $RegExp=$TopRight->Entry(-width=>30)->pack(); 52: my $Text=$TopRight->Entry(-width=>30)->pack(); 53: 54: my $ResultTextFrame =$MW->Frame(%Border)->pack(-side=>'left'); 55: my $ResultTextLabel=$ResultTextFrame->Label(-justify=>'left',-text=>"PreMatch:\nMatch:\nPostMatch:\nResult:\n\$1..n")->pack(%Fill); 56: 57: my $ResultFrame =$MW->Frame(%Border)->pack(-side=>'left',%Fill); 58: my $ResultLabel=$ResultFrame->Label(-justify=>'left',-text=>"none\nnone\nnone\nnone")->pack(%Fill); 59: 60: 61: $MW->bind('all', '<KeyPress>', \&KeyPress); 62: MainLoop(); 63: 64: sub KeyPress 65: { 66: local $^W=0; 67: my $RegEx=$RegExp->get; 68: my $Text =$Text->get; 69: my (@Dollar,@Result,$Result,$Match,$PreMatch,$PostMatch); 70: my $Function; 71: my $FieldCodes=join "",'$Match=$&;', 72: '$PreMatch=$`;', 73: "\$PostMatch=\$';", 74: "\$Dollar[0]=\$1;", 75: "\$Dollar[1]=\$2;", 76: "\$Dollar[2]=\$3;", 77: "\$Dollar[3]=\$4;", 78: "\$Dollar[4]=\$5;"; 79: if (!$AsList) 80: { 81: $Function=join "",'($Result=$Text)=~',"$RegEx;",$FieldCodes; 82: } 83: else 84: { 85: $Function=join "",'@Result=($Text=~',"$RegEx);",$FieldCodes; 86: }; 87: eval $Function; 88: $Result||=join "|",@Result; 89: $Match||='none'; $PreMatch||='none'; $PostMatch||='none'; 90: $ResultLabel->configure(-text=>"$PreMatch\n$Match\n$PostMatch\n$Result\n@Dollar"); 91: $ResultLabel->update; 92: }; 93:
|
---|
Replies are listed 'Best First'. | |
---|---|
Re: Test-a-Rex
by jepri (Parson) on Sep 03, 2001 at 13:25 UTC | |
by japhy (Canon) on Sep 03, 2001 at 17:11 UTC | |
Re: Test-a-Rex
by patgas (Friar) on Sep 03, 2001 at 19:40 UTC | |
by ChOas (Curate) on Sep 04, 2001 at 12:14 UTC | |
by jepri (Parson) on Sep 05, 2001 at 13:59 UTC | |
by patgas (Friar) on Sep 04, 2001 at 21:56 UTC |
Back to
Craft