#!/usr/bin/perl
use warnings;
use strict;
our $fn = $ARGV[0] || "Scintilla.iface";
our %cat;
our $cat;
our $enu;
our $pre;
our $lex;
open FH, $fn or die "Failed to open iface file: $fn: $!\n";
our $last_comment = '';
## cat -> start a category
## fun -> a function
## get -> a property get function
## set -> a property set function
## val -> definition of a constant
## evt -> an event
## enu -> associate an enumeration with a set of vals with a prefix
## lex -> associate a lexer with the lexical classes it produces
open ENU, ">enums.h" or die "Failed to open enums.h file: $!\n";
for (<FH>) {
chomp;chomp;chomp;
s/[\r\n]+//g;
next if /^##/;
if(/^cat\s+(.*)\s*$/) {
last if $1 eq 'Deprecated';
}
if(/^$/) {
$last_comment = '';
next;
}
if(/^\s*#\s*(.*)\s*$/) {
$last_comment .= $1;
next;
}
if(/^(\w{3})\s+(.*)\s*$/) {
my $cmd = $1;
my $text = $2;
if($cmd eq 'cat') {
if(!defined $cat) {
$cat{$text} = { 'val' => {}, 'pre' => {}, 'enu' => {}, 'fun' => {}, 'evt' => {} };
}
$cat = $cat{$text};
$pre = $cat{$text}{'pre'};
next;
}
elsif($cmd eq 'lex') {
# lex Python=SCLEX_PYTHON SCE_P_
# val SCE_P_DEFAULT=0
my ($lang, $macro, $prefix) = split(/[\s=]+/, $text);
$enu = exists $cat->{'enu'}{$macro} ? $cat->{'enu'}{$macro} : $cat->{'enu'}{$macro}={};
$enu->{'name'} = $lang;
$enu->{'prefix'} = $prefix;
my $p = ((exists $pre->{$prefix}) ? $pre->{$prefix} : ($pre->{$prefix}=[]));
push @$p, $macro;
}
elsif($cmd eq 'val') {
# this is all wrong, need to compare the val name against the prefix lists
my ($enam,$eval) = split(/=/, $text);
$cat{'Basics'}{'val'}{$enam} = $eval;
=pod
for my $key (keys %$pre) {
if($enam =~ /^$key/) {
push @{$pre->{$key}[1]}, [$enam,$eval];
print "Adding $enam to $key\n";
}
}
=cut
}
elsif($cmd eq 'fun' || $cmd eq 'get' || $cmd eq 'set') {
## get bool GetMarginSensitiveN=2247(int margin,)
# kill $lex and $enu here
my ($type, $name, $id, $arg1, $arg2) = ($text =~ /(\w+)\s+(\w+)\s*=\s*(\d+)\(([^,]*),([^\)]*)\)/);
#print "$cmd $type $name=$id($arg1, $arg2)\n";
#push @{}, { name =
}
elsif($cmd eq 'evt') {
$lex = $enu = undef;
# evt void StyleNeeded=2000(int position)
my ($ret, $nam, $id, $args) = ($text =~ /(\w+)\s+(\w+)\s*=(\d+)\s*\(([^\)]+)\)/);
#printf "evt %s %s=%i(%s)\n", $ret, $nam, $id, $args;
}
elsif($cmd eq 'enu') {
my ($enam,@eval) = split(/[=\s]+/, $text);
for my $eval (@eval) {
# print "enu $enam=$eval\n";
if(exists $cat->{'enu'}{$enam}) {
$enu = $cat->{'enu'}{$enam};
push @{$enu->{'prefix'}}, $eval;
} else {
$enu = $cat->{'enu'}{$enam} = {};
$enu->{'name'} = $enam;
$enu->{'prefix'} = [ $eval ];
}
my $p = ((exists $pre->{$eval}) ? $pre->{$eval} : ($pre->{$eval}=[]));
push @$p, $enam;
}
# print "enu $enam=$eval\n";
}
else {
print "$cmd: $text\n";
}
}
}
close FH;
#use Data::Dumper;
#print Dumper(\%cat);
sub cat($) : lvalue { $cat{'Basics'}{shift()} }
my @sclex;
my %chomp = (
'CHARSET' => '',
'MARKNUM' => '',
'WRAPVISUALFLAGLOC' => '',
'EOL' => '',
);
my %hmapping = (
'NULL' => 'NONE',
);
for my $enu (sort keys %{cat 'enu'}) {
my $te = cat('enu');
if($enu =~ /^SCLEX_/) {
push @sclex, $te->{$enu};
next;
}
print ENU "\tstruct $te->{$enu}{'name'}\n\t{\n\t\tenum \n\t\t{\n";
if(defined $te && defined $te->{$enu}) {
for my $prefix (@{$te->{$enu}{'prefix'}}) {
my %tmp;
for my $val (keys %{cat 'val'}) {
#print "\t$val = " . cat('val')->{$val} . ",\n" if $val =~ /^$prefix/;
$tmp{cat('val')->{$val}} = $val if $val =~ /^$prefix/;
}
for my $val (sort { if($a !~ /0x/) { $a <=> $b } else { $a cmp $b } } keys %tmp) {
my @items = split '_', $tmp{$val};
shift @items; shift @items if scalar @items > 1;
if(uc($items[0]) =~ /\U$te->{$enu}->{'name'}\E/) {
if(scalar @items > 1) {
shift @items;
} else {
$items[0] =~ s/\U$te->{$enu}->{'name'}\E//;
}
}
elsif(uc($te->{$enu}->{'name'}) =~ /\U$items[0]\E/) {
if(scalar @items > 1) {
shift @items;
} else {
$items[0] =~ s/\U$te->{$enu}->{'name'}\E//;
}
}
$items[0] =~ s/^(\d+)$/_$1/;
$items[0] = $hmapping{uc($items[0])} if exists $hmapping{uc($items[0])};
shift @items if exists $chomp{uc $items[0]};
$tmp{$val} = join '_', @items;
print ENU "\t\t\t$tmp{$val} = $val,\n";
}
}
}
print ENU "\t\t};\n\t};\n\n";
}
%hmapping = (
'HJ' => 'JavaScript',
'HJA' => 'AspJavaScript',
'HB' => 'VBScript',
'HBA' => 'AspVBScript',
'HP' => 'Python',
'P' => 'Python',
'HPA' => 'AspPython',
'HPHP' => 'PHP',
'HA' => 'Haskel',
# 'PL' => 'Perl',
'FS' => 'FlagShip',
'PROPS' => 'PROP',
# 'H' => 'HTML',
'BAT' => 'Batch',
'AVE' => 'Avenue',
'ERR' => 'ErrorList',
'L' => 'Latex',
'MAKE' => 'Makefile',
'V' => 'Verilog',
);
%chomp = (
'CLW' => '',
'MATLAB' => '',
'SH' => '',
'PL' => '',
'SCRIPTOL' => '',
'SN' => '',
'HASKEL' => '',
'RB' => '',
'C' => '',
'ST' => '',
'T3' => '',
'B' => '',
'PROP' => '',
'FLAGSHIP' => '',
'F' => '',
);
my $valr = cat 'val';
my %tmp;
my $sh = '';
my %enut;
my %tenu;
if(open(ENUT, "enums_desc.txt")) {
for (<ENUT>) {
chomp;
next if /^\s*$/;
/^([^\s]+)\s+(.*)$/;
$enut{$1} = $2;
}
close ENUT;
}
for my $val (sort keys %{$valr}) {
my @items = split '_', $val;
#print "val: $val\n";
next if $items[0] ne 'SCE';
$sh = '1' . shift @items;
my $nam = join '_', @items;
my $enu = cat 'enu';
for my $c (sort keys %{$enu}) {
next if $c !~ /^SCLEX_/;
my $cat = $enu->{$c};
#next if ref $cat->{'prefix'};
#my $pre = $cat->{'prefix'};
if(ref $cat->{'prefix'}) {
for my $pre (sort @{$cat->{'prefix'}}) {
if(uc($val) =~ /^\U$pre\b\E/) {
shift @items;
my $t = ((exists $tmp{$cat->{'name'}}) ? $tmp{$cat->{'name'}} : ($tmp{$cat->{'name'}}={}));
$t->{$valr->{$val}} = join('_',@items); # uc($cat->{'name'}) . "_" .
# print "Add enu $cat->{'name'}\n";
# last;
}
}
} else {
my $pre = $cat->{'prefix'};
if(uc($val) =~ /^\U$pre\E/) {
if(defined $items[0] && $items[0] eq 'H') {
# print "H!!!!!!!!!!!!!!!!!!!\n";
$items[0] = 'HTML';
}
if($items[0] eq 'HTML' && $items[1] eq 'SGML') {
shift @items;
} elsif($items[0] eq 'HTML') {
# print "HTML: $items[1]\n";
}
if(exists $chomp{uc($items[0])}) { # chomp removable items
my $tmp = shift @items ;
print "chomped: $tmp\n";
}
if(exists $hmapping{uc($items[0])}) {
my $tmp = $items[0];
$items[0] = uc($hmapping{uc($items[0])});
print "map: $tmp -> $items[0]\n";
}
# shift @items if uc($cat->{'name'}) =~ /^\U$items[0]\E/ && scalar @items > 1 && uc($items[0]) ne 'HTML' && uc($items[0]) ne 'H';
if(uc($cat->{'name'}) =~ /^$items[0]\b/i && uc($items[0]) ne 'HTML' && uc($items[0]) ne 'H' && uc($items[0]) ne 'PHP') {
my $pv = shift @items;
print "shifted: '$pv' pre:'$pre' cname:'" . $cat->{'name'} . "' i0:'" . $items[0] . "'\n";
}
shift @items if exists $chomp{uc($items[0])};
my $t = ((exists $tmp{$cat->{'name'}}) ? $tmp{$cat->{'name'}} : ($tmp{$cat->{'name'}}={}));
my $name = join('_',@items);
$t->{$valr->{$val}} = $name; # uc($cat->{'name'}) . "_" .
# shift @items if(defined $items[0] && $items[0] =~ /^ASP/);
$name = join('_',@items);
$enut{$name} = '' if !exists $enut{$name};
# print "shift: '$sh'\n";
#last;
}
}
}
}
=pod
use Data::Dumper;
print Dumper(\%tmp);
exit 0;
=cut
#exit;
print ENU "\tstruct Lex\n\t{\n";
for my $val (sort keys %tmp) { #
print ENU "\t\tstruct " . ucfirst(lc($val)) . " {\n\t\t\tenum \n\t\t\t{\n";
for my $item (sort { if($a !~ /0x/) { $a <=> $b } } keys %{$tmp{$val}}) {
print ENU "\t\t\t\t$tmp{$val}{$item} = " . $item . ",\n";
}
print ENU "\t\t\t};\n\t\t};\n";
}
print ENU "\t};\n";
close ENU;
my @enutwarn;
open ENUT, ">enums_desc.txt" or die "Failed to open enums_desc.txt: $!\n";
for (sort keys %enut) {
push @enutwarn, $_ if($enut{$_} eq '');
my @items = split '_', $_;
for my $item (@items) {
for my $hm (keys %hmapping) {
if(uc($item) eq uc($hmapping{$hm})) {
shift @items;
}
}
}
my $name = join '_', @items;
print ENUT $name . " " . $enut{$name} . "\n";
}
close ENUT;
=pod
if(scalar @enutwarn) {
print "The following ENUM elements need a short description:\n";
for (sort @enutwarn) {
print "\t" . $_ . "\n";
}
print "\nPlease edit enums_desc.txt to add a short blurb for each item.\n";
}
=cut
RSS Feed