eppearl.pl

Index

File = [eppearl.pl]
#!/perl
 
my $perlstx = 'C:/Program Files/EditPlus 2/perl.stx'; ### fix location - should maintain separate list???
my $verb3 = 1;
 
### is this everything ? ;=))
### see sub ispunctuat ($ch) service
@PPunct = ("&", "&&", "&&=", "&=",
    "<", "<<", "<<=", "<&=", "<&",
    "<=", "<==>", ">", ">&", ">>",
    ">>=", ">=",
    "*", "**", "**=", "*=", "*?",
    "@", "@*,", "@_",
    "`", "\\",
    "!", "!=",
    "^", "^=",
    ":", "::", ",", "\$",
    ".", "\"",
    "=", "=>", "==", "=~",
    ">", "#", "-", "->",
    "-*-", "-=", "--", "-|",
    "%", "%=",
    "+", "+=", "++", "+?",
    "#", "?", "?:", "?...?",
    "'", "\"", ";", "#!",
    "/", "/=", "//", "/.../",
    "~", "~~",
    "_","|", "|=", "|-", "||", "||=",
    "/o"
    );
 
@PPairs = (
    "<", ">",
    "<%", "%>",
    "{", "}",
    "[", "]",
    "(", ")",
    );
 
@DolVars = ( "\$1", "\$2", "\$3",
    "\$&", "\$<", "\$>", "\$'", "\$*",
    "\$@", "\$`", "\$\\", "\$!", "\$[",
    "\$]", "\$^", "\$^A", "\$^F",
    "\$^H", "\$^I", "\$^L", "\$^M",
    "\$^O", "\$^P", "\$^T", "\$^W", "\$^X",
    "\$:", "\$,", "\$.", "\$=", "\$-",
    "\$(", "\$)", "\$%", "\$+", "\$?",
    "\$\"", "\$;", "\$/","\$~",
    "\$_", "\$|"
    );
 
@PBPunc = (
    "(?!)", "(?!...", "(?:)",
    "(?...)", "(?=)", "(?#)", "(?i)"
    );
 
@ResWds2 = qw(if until while elsif else unless for
    foreach continue exit die last goto next
    redo return local exec sub do dump use
    require package eval my BEGIN END);
 
 
# ==========================================================================
# this is just to load the set of BUILT-IN FUNCTIONS and RESERVED WORDS
# eventually should perhaps be separated from this EditPlus.stx file format
#
# ==========================================================================
sub do_stx_file {
my %stxh = ();
my $icnt = 0;
###### pre-process perl.stx file ######################################
open $STX, "<$perlstx" or die "Can NOT locate $perlstx file...\n";
my @stx = <$STX>; ### slurp file to an array
close($STX);
$i = @stx;
tolog ("List of $i STX file lines...\n");
my $sw = 0; # no switch on
foreach $line (@stx) {
    $icnt++;
    chomp $line;
    my $ll = length($line); # get LENGTH of file line
    my @a;
    my $k;
    my $v;
    $c = substr ($line, 0, 1);
    $msg = '';
    if ($c eq ';') { # comment
        $msg = 'comment only';
    } elsif ($c eq '#') {
        # a line beginning with a HASH char
        if ( ($ll > 3) && ($line =~ /=/) ) { # hash item=value
            $msg = ' hash';
            @a = split('=', $line); # get key/value
            ($k, $v) = @a;
            $k = substr($k, 1);
            ###$stxh{$a[0]} = $a[1];
            if ( exists $stxh{$k} ) {
                if ($stxh{$k} eq $v) {
                    $msg .= ' same ';
                } else {
                    $msg .= ' new ';
                }
                $stxh{$k} .= '|' . $v;
                ###$v = $stxh{$k};
            } else {
                $stxh{$k} = $v;
            }
            ### $msg .= ' k=' . $a[0] . ' v=' . $a[1] . '-';
            ###$msg .= ' k=' . $k . ' v=' . $v . ' - ';
            $msg .= ' k=';
            $msg .= $k;
            $msg .= ' v=';
            $msg .= $stxh{$k};
            $msg .= ' - ';
            #KEYWORD=Reserved words
            #KEYWORD=Built-in functions
            if ($k eq 'KEYWORD') {
                if ($v eq 'Reserved words') {
                    $sw = 1;
                    $msg .= '(ResWds)';
                } elsif ($v eq 'Built-in functions') {
                    $sw = 2;
                    $msg .= '(BFuncs)';
                } else {
                    $sw = 0;
                }
            }
        } else {
            $msg .= ' WARNING: Unprocessed HASH line!';
        }
    }
 
    ###if ($ll > 1) {
    if ($ll > 0) {
        if ($sw == 1) {
            push(@ResWds, $line);
            if ( exists $HResWds{$line} ) {
                die "Duplicate RESERVE WORD [$line]\n"
            }
            $HResWds{$line} = $line;
            $msg .= " - rw+";
        } elsif ($sw == 2) {
            push(@BFuncs, $line);
            if ( exists $HBFuncs{$line} ) {
                die "Duplicate BUILT-IN FUNCTION [$line]\n"
            }
            $HBFuncs{$line} = $line;
            $msg .= " - bf+";
        } else {
            ###$msg .= " WARNING0 !1|2sw";
        }
    } else {
        $msg .= " empty";
    }
 
    ###tolog ($line . $msg . "\n") if $verb3;
    tolog ('Line' . $icnt . '=[' . $line . "]($ll) msg=[" . $msg . "]\n") if $verb3 ;
}
 
$line = 'new';
if ( ! exists $HBFuncs{$line} ) {
    $msg = ' ++Added';
    push(@BFuncs, $line);
    $HBFuncs{$line} = $line;
    tolog ($line . $msg . "\n");
}
 
$cnt1 = @ResWds;
$cnt2 = @BFuncs;
tolog ("END List of $i STX file lines...rw=$cnt1 bf=$cnt2 \n");
###### end-process perl.stx file ######################################
if ($NewRes) { # switch from perl.stx file - one day!
 my %hash1 = ();
 my %hash2 = ();
 my $k;
 foreach $line (@ResWds) {
    $hash1{$line} = 0;
 }
 foreach $line (@ResWds2) {
    $hash2{$line} = 0;
 }
 foreach $k (keys %hash1) {
    if (! exists $hash2{$k} ) {
        tolog "Can NOT locate [$k] in hash 2!\n";
    } else {
        $hash1{$k} = 1;
        $hash2{$k} = 1;
    }
 }
 foreach $k (keys %hash2) {
    if ($hash2{$k} == 0) {
        if (! exists $hash1{$k} ) {
            tolog "Can NOT locate [$k] in hash 1!\n";
        }
    }
 }
 tolog ('@common = qw(');
 foreach $k (keys %hash1) {
    if ($hash1{$k}) {
        tolog ("$k ");
    }
 }
 
 tolog (")\n");
} ### if $NewRes # switch from perl.stx file = one day ???
 
} ### exit STX file load
# ==========================================================================
 
1;

Colour Key :
Function, Description., Colour
Style Description Colour
match array l.blue
orange comment brown
regex unass l.br
green s-quote s.green
color1 scalar pink
color2 functions mauve
color3 d-quote b.green
color4 color4 color4
color5 color5 color5
peach hash l.brn
blue reserved blue
white other white
grey punctuation l.grey

Parse stats
Reserved Words
#ResWdCount
1require1
2next1
3do1
4my14
5local1
6foreach7
7if18
8redo1
9or1
10use1
11goto1
12eq6
13qw1
14for1
15last1
16else8
17unless1
18package1
19elsif4
20return1
21while1
22until1
23sub2
24continue1
List of 24 used reserve words ...
 
Built-in Functions
#FuncsCount
1dump1
2exit1
3substr2
4die4
5keys3
6open1
7push3
8close1
9length1
10chomp1
11exists6
12split1
13exec1
14eval1
List of 14 used built-in function words ...
 
Punctuation Used
#PuncuatCount
1==3
2&&1
3{52
4=51
5>3
6,135
7++1
8)50
9.23
10=~1
11}52
12;74
13(51
14<1
15!3
List of 15 used punctuation ...
 
Arrays
#U.ArraysCount
1@PPunct1
2@DolVars1
3@PPairs1
4@stx3
5@a3
6@BFuncs3
7@ResWds3
8@PBPunc1
9@ResWds22
List of 9 user arrays ...
 
Hash
#U.HashCount
1%hash13
2%stxh1
3%hash22
List of 3 user hash (associative arrays) ...
 
Scalar
#U.ScalarCount
1$NewRes1
2$i1
3$verb32
4$msg19
5$sw6
6$icnt3
7$perlstx1
8$HBFuncs4
9$k21
10$line25
11$c3
12$ll3
13$hash24
14$STX3
15$cnt21
16$v7
17$cnt11
18$hash14
19$HResWds2
20$stxh5
List of 20 user scalars ...
 

Index