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: