Line # Revision Author
1 1 moose #!/usr/bin/perl
2
3 use warnings;
4 use strict;
5
6 our $fn = $ARGV[0] || "Scintilla.iface";
7 our %cat;
8 our $cat;
9 our $enu;
10 our $pre;
11 our $lex;
12
13 open FH, $fn or die "Failed to open iface file: $fn: $!\n";
14
15 our $last_comment = '';
16
17 ## cat -> start a category
18 ## fun -> a function
19 ## get -> a property get function
20 ## set -> a property set function
21 ## val -> definition of a constant
22 ## evt -> an event
23 ## enu -> associate an enumeration with a set of vals with a prefix
24 ## lex -> associate a lexer with the lexical classes it produces
25
26 open ENU, ">enums.h" or die "Failed to open enums.h file: $!\n";
27
28 for (<FH>) {
29 chomp;chomp;chomp;
30 s/[\r\n]+//g;
31 next if /^##/;
32
33 if(/^cat\s+(.*)\s*$/) {
34 last if $1 eq 'Deprecated';
35 }
36
37 if(/^$/) {
38 $last_comment = '';
39 next;
40 }
41
42 if(/^\s*#\s*(.*)\s*$/) {
43 $last_comment .= $1;
44 next;
45 }
46
47 if(/^(\w{3})\s+(.*)\s*$/) {
48 my $cmd = $1;
49 my $text = $2;
50
51 if($cmd eq 'cat') {
52 if(!defined $cat) {
53 $cat{$text} = { 'val' => {}, 'pre' => {}, 'enu' => {}, 'fun' => {}, 'evt' => {} };
54 }
55
56 $cat = $cat{$text};
57 $pre = $cat{$text}{'pre'};
58 next;
59 }
60 elsif($cmd eq 'lex') {
61 # lex Python=SCLEX_PYTHON SCE_P_
62 # val SCE_P_DEFAULT=0
63 my ($lang, $macro, $prefix) = split(/[\s=]+/, $text);
64
65 $enu = exists $cat->{'enu'}{$macro} ? $cat->{'enu'}{$macro} : $cat->{'enu'}{$macro}={};
66 $enu->{'name'} = $lang;
67 $enu->{'prefix'} = $prefix;
68
69 my $p = ((exists $pre->{$prefix}) ? $pre->{$prefix} : ($pre->{$prefix}=[]));
70 push @$p, $macro;
71 }
72 elsif($cmd eq 'val') {
73 # this is all wrong, need to compare the val name against the prefix lists
74 my ($enam,$eval) = split(/=/, $text);
75
76 $cat{'Basics'}{'val'}{$enam} = $eval;
77 =pod
78 for my $key (keys %$pre) {
79 if($enam =~ /^$key/) {
80 push @{$pre->{$key}[1]}, [$enam,$eval];
81 print "Adding $enam to $key\n";
82 }
83 }
84 =cut
85
86 }
87 elsif($cmd eq 'fun' || $cmd eq 'get' || $cmd eq 'set') {
88 ## get bool GetMarginSensitiveN=2247(int margin,)
89 # kill $lex and $enu here
90 my ($type, $name, $id, $arg1, $arg2) = ($text =~ /(\w+)\s+(\w+)\s*=\s*(\d+)\(([^,]*),([^\)]*)\)/);
91 #print "$cmd $type $name=$id($arg1, $arg2)\n";
92 #push @{}, { name =
93 }
94 elsif($cmd eq 'evt') {
95 $lex = $enu = undef;
96 # evt void StyleNeeded=2000(int position)
97 my ($ret, $nam, $id, $args) = ($text =~ /(\w+)\s+(\w+)\s*=(\d+)\s*\(([^\)]+)\)/);
98 #printf "evt %s %s=%i(%s)\n", $ret, $nam, $id, $args;
99 }
100 elsif($cmd eq 'enu') {
101 my ($enam,@eval) = split(/[=\s]+/, $text);
102 for my $eval (@eval) {
103 # print "enu $enam=$eval\n";
104 if(exists $cat->{'enu'}{$enam}) {
105 $enu = $cat->{'enu'}{$enam};
106 push @{$enu->{'prefix'}}, $eval;
107 } else {
108 $enu = $cat->{'enu'}{$enam} = {};
109 $enu->{'name'} = $enam;
110 $enu->{'prefix'} = [ $eval ];
111 }
112
113 my $p = ((exists $pre->{$eval}) ? $pre->{$eval} : ($pre->{$eval}=[]));
114 push @$p, $enam;
115 }
116 # print "enu $enam=$eval\n";
117 }
118 else {
119 print "$cmd: $text\n";
120 }
121 }
122 }
123
124 close FH;
125
126 #use Data::Dumper;
127 #print Dumper(\%cat);
128
129 sub cat($) : lvalue { $cat{'Basics'}{shift()} }
130
131 my @sclex;
132
133 my %chomp = (
134 'CHARSET' => '',
135 'MARKNUM' => '',
136 'WRAPVISUALFLAGLOC' => '',
137 'EOL' => '',
138 );
139
140 my %hmapping = (
141 'NULL' => 'NONE',
142 );
143
144 for my $enu (sort keys %{cat 'enu'}) {
145 my $te = cat('enu');
146 if($enu =~ /^SCLEX_/) {
147 push @sclex, $te->{$enu};
148 next;
149 }
150
151 print ENU "\tstruct $te->{$enu}{'name'}\n\t{\n\t\tenum \n\t\t{\n";
152
153 if(defined $te && defined $te->{$enu}) {
154 for my $prefix (@{$te->{$enu}{'prefix'}}) {
155 my %tmp;
156
157 for my $val (keys %{cat 'val'}) {
158 #print "\t$val = " . cat('val')->{$val} . ",\n" if $val =~ /^$prefix/;
159 $tmp{cat('val')->{$val}} = $val if $val =~ /^$prefix/;
160 }
161 for my $val (sort { if($a !~ /0x/) { $a <=> $b } else { $a cmp $b } } keys %tmp) {
162 my @items = split '_', $tmp{$val};
163 shift @items; shift @items if scalar @items > 1;
164
165 if(uc($items[0]) =~ /\U$te->{$enu}->{'name'}\E/) {
166 if(scalar @items > 1) {
167 shift @items;
168 } else {
169 $items[0] =~ s/\U$te->{$enu}->{'name'}\E//;
170 }
171 }
172 elsif(uc($te->{$enu}->{'name'}) =~ /\U$items[0]\E/) {
173 if(scalar @items > 1) {
174 shift @items;
175 } else {
176 $items[0] =~ s/\U$te->{$enu}->{'name'}\E//;
177 }
178 }
179
180 $items[0] =~ s/^(\d+)$/_$1/;
181
182 $items[0] = $hmapping{uc($items[0])} if exists $hmapping{uc($items[0])};
183 shift @items if exists $chomp{uc $items[0]};
184
185 $tmp{$val} = join '_', @items;
186 print ENU "\t\t\t$tmp{$val} = $val,\n";
187 }
188 }
189 }
190
191 print ENU "\t\t};\n\t};\n\n";
192 }
193
194
195 %hmapping = (
196 'HJ' => 'JavaScript',
197 'HJA' => 'AspJavaScript',
198 'HB' => 'VBScript',
199 'HBA' => 'AspVBScript',
200 'HP' => 'Python',
201 'P' => 'Python',
202 'HPA' => 'AspPython',
203 'HPHP' => 'PHP',
204 'HA' => 'Haskel',
205 # 'PL' => 'Perl',
206 'FS' => 'FlagShip',
207 'PROPS' => 'PROP',
208 # 'H' => 'HTML',
209 'BAT' => 'Batch',
210 'AVE' => 'Avenue',
211 'ERR' => 'ErrorList',
212 'L' => 'Latex',
213 'MAKE' => 'Makefile',
214 'V' => 'Verilog',
215 );
216
217 %chomp = (
218 'CLW' => '',
219 'MATLAB' => '',
220 'SH' => '',
221 'PL' => '',
222 'SCRIPTOL' => '',
223 'SN' => '',
224 'HASKEL' => '',
225 'RB' => '',
226 'C' => '',
227 'ST' => '',
228 'T3' => '',
229 'B' => '',
230 'PROP' => '',
231 'FLAGSHIP' => '',
232 'F' => '',
233 );
234
235 my $valr = cat 'val';
236 my %tmp;
237 my $sh = '';
238 my %enut;
239 my %tenu;
240
241 if(open(ENUT, "enums_desc.txt")) {
242
243 for (<ENUT>) {
244 chomp;
245 next if /^\s*$/;
246 /^([^\s]+)\s+(.*)$/;
247 $enut{$1} = $2;
248 }
249 close ENUT;
250 }
251
252 for my $val (sort keys %{$valr}) {
253 my @items = split '_', $val;
254 #print "val: $val\n";
255 next if $items[0] ne 'SCE';
256
257 $sh = '1' . shift @items;
258 my $nam = join '_', @items;
259
260 my $enu = cat 'enu';
261 for my $c (sort keys %{$enu}) {
262 next if $c !~ /^SCLEX_/;
263 my $cat = $enu->{$c};
264
265 #next if ref $cat->{'prefix'};
266 #my $pre = $cat->{'prefix'};
267
268 if(ref $cat->{'prefix'}) {
269 for my $pre (sort @{$cat->{'prefix'}}) {
270 if(uc($val) =~ /^\U$pre\b\E/) {
271 shift @items;
272 my $t = ((exists $tmp{$cat->{'name'}}) ? $tmp{$cat->{'name'}} : ($tmp{$cat->{'name'}}={}));
273 $t->{$valr->{$val}} = join('_',@items); # uc($cat->{'name'}) . "_" .
274 # print "Add enu $cat->{'name'}\n";
275 # last;
276 }
277 }
278 } else {
279 my $pre = $cat->{'prefix'};
280
281 if(uc($val) =~ /^\U$pre\E/) {
282
283 if(defined $items[0] && $items[0] eq 'H') {
284 # print "H!!!!!!!!!!!!!!!!!!!\n";
285 $items[0] = 'HTML';
286 }
287
288 if($items[0] eq 'HTML' && $items[1] eq 'SGML') {
289 shift @items;
290 } elsif($items[0] eq 'HTML') {
291 # print "HTML: $items[1]\n";
292 }
293
294
295 if(exists $chomp{uc($items[0])}) { # chomp removable items
296 my $tmp = shift @items ;
297 print "chomped: $tmp\n";
298 }
299
300 if(exists $hmapping{uc($items[0])}) {
301 my $tmp = $items[0];
302 $items[0] = uc($hmapping{uc($items[0])});
303 print "map: $tmp -> $items[0]\n";
304 }
305
306 # shift @items if uc($cat->{'name'}) =~ /^\U$items[0]\E/ && scalar @items > 1 && uc($items[0]) ne 'HTML' && uc($items[0]) ne 'H';
307 if(uc($cat->{'name'}) =~ /^$items[0]\b/i && uc($items[0]) ne 'HTML' && uc($items[0]) ne 'H' && uc($items[0]) ne 'PHP') {
308 my $pv = shift @items;
309 print "shifted: '$pv' pre:'$pre' cname:'" . $cat->{'name'} . "' i0:'" . $items[0] . "'\n";
310 }
311
312 shift @items if exists $chomp{uc($items[0])};
313
314
315 my $t = ((exists $tmp{$cat->{'name'}}) ? $tmp{$cat->{'name'}} : ($tmp{$cat->{'name'}}={}));
316 my $name = join('_',@items);
317 $t->{$valr->{$val}} = $name; # uc($cat->{'name'}) . "_" .
318
319 # shift @items if(defined $items[0] && $items[0] =~ /^ASP/);
320 $name = join('_',@items);
321 $enut{$name} = '' if !exists $enut{$name};
322
323 # print "shift: '$sh'\n";
324 #last;
325 }
326 }
327 }
328
329
330 }
331
332 =pod
333 use Data::Dumper;
334 print Dumper(\%tmp);
335 exit 0;
336 =cut
337
338 #exit;
339
340 print ENU "\tstruct Lex\n\t{\n";
341
342 for my $val (sort keys %tmp) { #
343 print ENU "\t\tstruct " . ucfirst(lc($val)) . " {\n\t\t\tenum \n\t\t\t{\n";
344
345 for my $item (sort { if($a !~ /0x/) { $a <=> $b } } keys %{$tmp{$val}}) {
346 print ENU "\t\t\t\t$tmp{$val}{$item} = " . $item . ",\n";
347 }
348 print ENU "\t\t\t};\n\t\t};\n";
349 }
350
351 print ENU "\t};\n";
352
353 close ENU;
354
355 my @enutwarn;
356 open ENUT, ">enums_desc.txt" or die "Failed to open enums_desc.txt: $!\n";
357 for (sort keys %enut) {
358 push @enutwarn, $_ if($enut{$_} eq '');
359 my @items = split '_', $_;
360 for my $item (@items) {
361 for my $hm (keys %hmapping) {
362 if(uc($item) eq uc($hmapping{$hm})) {
363 shift @items;
364 }
365 }
366 }
367 my $name = join '_', @items;
368 print ENUT $name . " " . $enut{$name} . "\n";
369 }
370 close ENUT;
371
372 =pod
373 if(scalar @enutwarn) {
374 print "The following ENUM elements need a short description:\n";
375 for (sort @enutwarn) {
376 print "\t" . $_ . "\n";
377 }
378 print "\nPlease edit enums_desc.txt to add a short blurb for each item.\n";
379 }
380 =cut