#!/usr/bin/perl -w
# NAME: m4scan.pl
# AIM: Scan an M4 auto-tools MACRO file
# 05/10/2010 geoff mclane http://geoffair.net/mperl
use strict;
use warnings;
use File::Basename;  # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] )
use File::Spec; # File::Spec->rel2abs($rel); # we are IN the SLN directory, get ABSOLUTE from RELATIVE
use Cwd;
my $perl_dir = 'C:\GTools\perl';
unshift(@INC, $perl_dir);
require 'lib_utils.pl' or die "Unable to load 'lib_utils.pl'! Check location and \@INC content.\n";
#require 'logfile.pl' or die "Unable to load logfile.pl ...\n";
# log file stuff
my ($LF);
my $pgmname = $0;
if ($pgmname =~ /(\\|\/)/) {
    my @tmpsp = split(/(\\|\/)/,$pgmname);
    $pgmname = $tmpsp[-1];
}
my $outfile = $perl_dir."\\temp.$pgmname.txt";
open_log($outfile);

# user variables
my $load_log = 0;
my $in_file = '';
my $use_trim_all = 0;

my $debug_on = 1;
my $def_file = 'C:\Projects\Cairo\acinclude.m4';

### program variables
my @warnings = ();
my $cwd = cwd();
my $os = $^O;
my %ref_params = ();

sub show_warnings($) {
    my ($val) = @_;
    if (@warnings) {
        prt( "\nGot ".scalar @warnings." WARNINGS...\n" );
        foreach my $itm (@warnings) {
           prt("$itm\n");
        }
        prt("\n");
    } else {
        prt( "\nNo warnings issued.\n\n" );
    }
}

sub pgm_exit($$) {
    my ($val,$msg) = @_;
    if (length($msg)) {
        $msg .= "\n" if (!($msg =~ /\n$/));
        prt($msg);
    }
    show_warnings($val);
    close_log($outfile,$load_log);
    exit($val);
}


sub prtw($) {
   my ($tx) = shift;
   $tx =~ s/\n$//;
   prt("$tx\n");
   push(@warnings,$tx);
}

# debug
my $dbg_m401 = 0;
my $dbg_m402 = 0;
my $dbg_m403 = 0;
my $dbg_m404 = 0;
my $dbg_m405 = 0;
my $dbg_m406 = 0;
my $dbg_m407 = 1;

# $cline = accumulate_with_back($cline,$lncnt,\$ln,\@lines);
sub m4_accumulate_with_back($$$$) {
    my ($iline,$lncnt,$rln,$rlines) = @_;
    my ($nline,$oline);
    $oline = $iline;
    $oline =~ s/\\$//;
    $oline = substr($oline,0,length($oline) - 1) while ($oline =~ /\s$/); # remove all TRAILING space
    my $ln = ${$rln};
    while ($iline =~ /\\$/) {
        $iline =~ s/\\$//;  # remove '\'
        $iline = substr($iline,0,length($iline) - 1) while ($iline =~ /\s$/); # remove all TRAILING space
        $ln++;
        if ($ln < $lncnt) {
            $nline = trim_all(${$rlines}[$ln]);
            if (length($nline)) {
                $iline .= " ";
                $iline .= $nline;
            }
        } else {
            last;
        }
    }
    ${$rln} = $ln;  # pass back potentially new line...
    if ($dbg_m401 && ($oline ne $iline)) {
        prt("Accumulated back from\n[$oline] to line $ln\n[$iline]\n");
    }
    return $iline;
}

# =======================================================================
# based on ALL AC_MACROS are of the form
# AC_MACRO([...],....,....), could also check [ ], but that's for later..
# $cline = accumulate_ac_macro($cline,$lncnt,\$ln,\@lines);
# =======================================================================
sub m4_accumulate_ac_macro($$$$) {
    my ($iline,$lncnt,$ri,$rlines) = @_;
    my ($i,$ch,$brcnt,$k,$k2,$lcnt,$acmac,$oline,$sqcnt,$bgnln);
    # prt("Accumulate AC MACRO until end...\n");
    $k = ${$ri};    # extract current line number, 0 based
    $bgnln = $k + 1;
    $oline = $iline;
    my $len = length($iline);
    prt("[02] $bgnln: Doing line [$iline], len $len\n") if ($dbg_m402);
    # eat any initial space only
    for ($i = 0; $i < $len; $i++) {
        $ch = substr($iline,$i,1);
        last if ($ch =~ /\S/);  # stop on first non-white space
    }
    $acmac = '';    # accumulate the name of the MACRO
    for (; $i < $len; $i++) {
        $ch = substr($iline,$i,1);
        last if ($ch =~ /\W/);  # stop on non-alpha-numeric - should be '('
        $acmac .= $ch;
    }
    # could allow 'space' BEFORE '('
    # ONE DAY

    pgm_exit(1,"ERROR: mac=[$acmac] Fix m4_accumulate_ac_macro to accept [$ch] following 'name'!\n") if ($ch ne '(');

    # essentially get to END of MACRO - may be mutiple lines
    $i++;   # note, BUMP past FIRST '(', and set $brcnt == 0
    $brcnt = 0;
    $sqcnt = 0;
    $lcnt = 1;
    for (; $i < $len; $i++) {
        $ch = substr($iline,$i,1);
        if ($ch eq '(') {
            if (!$sqcnt) {
                $brcnt++;
                prt("[03]:1:$i:$len: br=$brcnt sq=$sqcnt bumped br count\n") if ($dbg_m403);
            } else {
                prt("[03]:1:$i:$len: br=$brcnt sq=$sqcnt skipped br count due sqcnt\n") if ($dbg_m403);
            }
        } elsif ($ch eq '[') {
            $sqcnt++;
            prt("[02]:1:$i:$len: br=$brcnt sq=$sqcnt bumped sq count\n") if ($dbg_m402);
        } elsif ($ch eq ']') {
            prt("[02]:1:$i:$len: br=$brcnt sq=$sqcnt will decrement sq count\n") if ($dbg_m402);
            $sqcnt-- if ($sqcnt);
        } elsif ($ch eq ')') {
            if ($sqcnt) {
                $ch = '';
                prt("[02]:1:$i:$len: br=$brcnt sq=$sqcnt skipped br decement due sq count\n") if ($dbg_m402);
            } else {
                if ($brcnt) {
                    $brcnt--;
                    $ch = '';
                     prt("[02]:1:$i:$len: br=$brcnt sq=$sqcnt decrement br count\n") if ($dbg_m402);
                } else {
                    prt("[02]:1:$i:$len: br=$brcnt sq=$sqcnt EXIT0\n") if ($dbg_m402);
                    last;
                }
            }
        }
    }

    if ($ch ne ')') {   # oops, need more lines
        $k++;
        $k2 = $k + 1;
        my $nline = '';
        prt( "\n[04] br=$brcnt sq=$sqcnt no closed! Get next line $k, of $lncnt lines\n" ) if ($dbg_m404);
        while ($k < $lncnt) {
            #prt( "$k2:$.: need more lines...br=$brcnt, sq=$sqcnt...\n" ); # if ($dbg01);
            if ($use_trim_all) {
                $nline = trim_all(${$rlines}[$k]);
            } else {
                $nline = ${$rlines}[$k];
                chomp $nline;
            }
            $lcnt++;
            $len = length($nline);
            prt( "[04] br=$brcnt sq=$sqcnt line=$lcnt, len=$len [$nline]\n" ) if ($dbg_m404);
            for ($i = 0; $i < $len; $i++) {
                $ch = substr($nline,$i,1);
                if ($ch eq '(') {
                    if ($sqcnt) {
                        $ch = '';
                        prt("[04] br=$brcnt sq=$sqcnt skipped br count due sqcnt\n") if ($dbg_m404);
                    } else {
                        $brcnt++;
                        prt("[04] br=$brcnt sq=$sqcnt bumped br count\n") if ($dbg_m404);
                    }
                } elsif ($ch eq '[') {
                    $sqcnt++;
                    prt("[04] br=$brcnt sq=$sqcnt bumped sq count\n") if ($dbg_m404);
                } elsif ($ch eq ']') {
                    prt("[04] br=$brcnt sq=$sqcnt will decrement sq count\n") if ($dbg_m404);
                    $sqcnt-- if ($sqcnt);
                } elsif ($ch eq ')') {
                    if ($sqcnt) {
                        $ch = '';
                        prt("[04] br=$brcnt sq=$sqcnt skipped br decement due sq count\n") if ($dbg_m404);
                    } else {
                        if ($brcnt) {
                            $brcnt--;
                            $ch = '';   # CLEAR this char - is NOT the end
                            prt("[04] br=$brcnt sq=$sqcnt decrement sq count\n") if ($dbg_m404);
                        } else {
                            prt("[04] br=$brcnt sq=$sqcnt EXIT1\n") if ($dbg_m404);
                            last;
                        }
                    }
                }
            }
            if ($ch eq ')') {
                prt("[04] br=$brcnt sq=$sqcnt EXIT2\n") if ($dbg_m404);
                if (length($nline)) {
                    #$iline .= ' ' if ( !( ($iline =~ /\s$/) || ($nline =~ /^\s/) ) );
                    if ($use_trim_all) {
                        $iline .= " "; # "\n";
                    } else {
                        $iline .= "\n";
                    }
                    $iline .= $nline;
                    $nline = '';
                }
                last;
            }
            $k++;   # need MORE
            $k2 = $k + 1;
            if (length($nline)) {
                #$iline .= ' ' if ( !( ($iline =~ /\s$/) || ($nline =~ /^\s/) ) );
                if ($use_trim_all) {
                    $iline .= " "; # "\n";
                } else {
                    $iline .= "\n";
                }
                $iline .= $nline;
                $nline = '';
            }
        }
        if ($k >= $lncnt) {
            $ch = ${$ri};    # extract current line number
            prt("Started at line $ch, and now at line $k, of $lncnt, searching AC MACRO [$acmac] end...\n");
            my $tmp = trim_all($iline);
            if (length($tmp) > 200) {
                $nline = substr($tmp,0,100)."...\n".substr($tmp,(length($tmp) - 100));
                prt("Have accumulated [$nline]!\n");
            } else {
                prt("Have accumulated [$tmp]!\n");
            }
            pgm_exit(1,"ERROR: Ran out of line in an ac macro!\n");
        }
        ${$ri} = $k;    # pass back new line number
    } else {
        prt( "[04] Closed in current line\n" ) if ($dbg_m404);
    }

    if ($dbg_m405 && ($oline ne $iline)) {
        prt("Accumulated from [$bgnln]\n[$oline] to line $k2\n[$iline]\n");
    }
    return $iline;
}

sub get_ref_params() {
    my $rh = \%ref_params;
    return $rh;
}

sub remove_dnl($) {
    my ($txt) = shift;
    return '' if ($txt =~ /^dnl\s*$/);
    if ($txt =~ /dnl/m) {
        my $ntxt = '';
        my $len = length($txt);
        my ($i,$ch,$pc,$rem);
        $ch = ' ';
        for ($i = 0; $i < $len; $i++) {
            $pc = $ch;
            $ch = substr($txt,$i,1);
            if (($ch eq 'd')&&($pc =~ /\W/)) {
                $rem = substr($txt,$i);
                if ($rem =~ /^dnl\W+/) {
                    $i += 3;
                    for (; $i < $len; $i++) {
                        $ch = substr($txt,$i,1);
                        next if ($ch eq "\n");
                        last if ($ch =~ /\S/);
                    }
                }
            }
            $ntxt .= $ch;
        }
        $txt = $ntxt;
    }
    return $txt;
}

sub trim_head_tail($) {
    my $txt = shift;
    $txt = trim_ends($txt);
    return $txt;
}

sub m4_comma_split($) {
    my ($line) = @_;
    my $len = length($line);
    my ($i,$ch,$insq,$item,$inbr,$hadcom);
    $insq = 0;
    $item = '';
    $inbr = 0;
    $hadcom = 0;
    my @arr = ();
    prt("[06] Comma split [$line]\n") if ($dbg_m406);
    for ($i = 0; $i < $len; $i++) {
        $ch = substr($line,$i,1);
        if ($insq) {
            if ($ch =~ /\S/) {
                $item .= $ch;
                $hadcom = 0;
            } elsif ($hadcom == 0) {
                $item .= $ch;
            #} elsif (length($item)) {
            #    $item .= $ch;
            }
            if ($ch eq ']') {
                $insq--;
                prt(" [06] IS: Close square [$item], to [$insq], inbr $inbr\n") if ($dbg_m406);
                $hadcom = 0;
            } elsif ($ch eq '(') {
                $inbr++;
                prt(" [06] IS: Open bracket [$item], in [$insq], or inbr $inbr\n") if ($dbg_m406);
                $hadcom = 0;
            } elsif ($ch eq ')') {
                $inbr-- if ($inbr);
                prt(" [06] IS: Close bracket [$item], in [$insq], or inbr $inbr\n") if ($dbg_m406);
                $hadcom = 0;
            } elsif ($ch eq ',') {
                prt(" [06] IS: Comma in square [$item], in [$insq], or inbr $inbr\n") if ($dbg_m406);
                $hadcom = 1;
            } elsif ($ch eq '[') {
                $insq++;
                prt(" [06] IS: Bump square [$item], in [$insq], or inbr $inbr\n") if ($dbg_m406);
                $hadcom = 0;
            } elsif ($ch =~ /\S/) {
                $hadcom = 0;
            }
        } elsif ($ch eq '[') {
            $item .= $ch;
            $insq++;
            prt("[06] Open square [$item], to [$insq], inbr $inbr\n") if ($dbg_m406);
            $hadcom = 0;
        } elsif ($ch eq ',') {
            if ($inbr || $insq) {
                $item .= $ch;
                prt("[06] Comma [$item], in [$insq], or inbr $inbr\n") if ($dbg_m406);
            } else {
                prt("[06] Comma split [$item], in [$insq], or inbr $inbr\n") if ($dbg_m406);
                push(@arr,$item);
                $item = '';
            }
            $hadcom = 1;
        } elsif ($ch eq ')') {
            if ($inbr) {
                $item .= $ch;
                prt("[06] Close bracket [$item], in [$insq], or inbr $inbr\n") if ($dbg_m406);
            } else {
                push(@arr,$item) if (length($item));
                $item = '';
                $item = substr($line,($i+1)) if (($i + 1) < $len);
                $item =~ s/.*\#.*$//;
                $item = remove_dnl($item);
                $item = trim_ends($item);
                prt("[07] Last bracket, rem [$item]\n") if ($dbg_m407);
                last;
            }
            $inbr-- if ($inbr);
            $hadcom = 0;
        } elsif ($ch eq '(') {
            $item .= $ch;
            $inbr++;
            prt("[06] Open bracket [$item], in [$insq], or inbr $inbr\n") if ($dbg_m406);
            $hadcom = 0;
        } else {
            if ($ch =~ /\S/) {
                $item .= $ch;
                $hadcom = 0;
            } elsif ($hadcom == 0) {
                $item .= $ch;
            #} elsif (length($item)) {
            #    $item .= $ch;
            }
        }
    }
    push(@arr,$item) if (length($item));
    return \@arr;
}

sub m4_split_macro($$$);

sub m4_split_macro($$$) {
    my ($rparams,$oline,$lev) = @_;
    my ($mac,$cont,$ra,$cnt1,$itm);
    my ($mac2,$cont2,$ra2,$itm2,$cnt2);
    my ($dcont,$ditm);
    my $line = $oline;
    $line = remove_dnl($line);
    my $ind = ' ';
    $ind .= '   ' x $lev;
    my @arr = ();
    #$line =~ s/\n/\$\{m4_newline\}/gm;
    $cnt1 = 0;
    if ($line =~ /^(\w+)\((.+)$/m) {
        $mac = $1;
        #$cont = $2; # this excludes after a CR???
        $cont = substr($line,(length($mac)+1));
        $dcont = $cont;
        $dcont =~ s/\n/ /gm;
        prt("\n") if ($lev == 0);
        prt("${ind}GOOD MAC [$mac], with [$dcont]\n");
        #$cont =~ s/\$\{m4_newline\}/\n/gm;
        $ra = m4_comma_split($cont);
        $cnt1 = scalar @{$ra};
        prt("${ind}MAC [$mac], with $cnt1 components...\n");
        $cnt1 = 0;
        foreach $itm (@{$ra}) {
            $cnt1++;
            $ditm = $itm;
            $ditm =~ s/\n/ /gm;
            if ($ditm =~ /^\[(.*)\]$/) {
                $itm = substr($itm,1,(length($itm)-2));
                $ditm = substr($ditm,1,(length($ditm)-2));
            }
            if ($itm =~ /^(\w+)\((.+)$/m) {
                $mac2 = $1;
                prt( "${ind}$cnt1: as MAC2 [$mac2] [".$ditm."]\n");
                $ra2 = m4_split_macro($rparams,$itm,($lev+1));
            } else {
                prt( "${ind}$cnt1: {".$ditm."}\n");
            }
        }
    } else {
        $ra = \@arr;
        prt("\n${ind}NOT AN M4 MACRO [$line]\n");
        if ($line =~ /^(\w+)\(/) {
            $mac = $1;
            $cont = substr($line,(length($mac)+1));
            prt("${ind}Starts with [$mac] ok, but after [$cont]\n");
            if ($cont =~ /\)$/m) {
                prt("${ind}And ends ok with ')' - WHAT IS WRONG?\n");
            } else {
                prt("${ind}Does NOT END in ')'?\n");
            }   
        } else {
            prt("${ind}Does NOT start properly...\n");
        }
    }
    return $ra;
}

sub m4_split_macro_quite_good($$$) {
    my ($rparams,$oline,$lev) = @_;
    my ($mac,$cont,$ra,$cnt1,$itm);
    my ($mac2,$cont2,$ra2,$itm2,$cnt2);
    my ($mac3,$cont3,$ra3,$itm3,$cnt3);
    my ($dcont,$ditm);
    my $line = $oline;
    $line = remove_dnl($line);
    my $ind = ' ';
    $ind .= '   ' x $lev;
    my @arr = ();
    #$line =~ s/\n/\$\{m4_newline\}/gm;
    $cnt1 = 0;
    if ($line =~ /^(\w+)\((.+)$/m) {
        $mac = $1;
        #$cont = $2; # this excludes after a CR???
        $cont = substr($line,(length($mac)+1));
        $dcont = $cont;
        $dcont =~ s/\n/ /gm;
        prt("\n") if ($lev == 0);
        prt("${ind}GOOD MAC [$mac], with [$dcont]\n");
        #$cont =~ s/\$\{m4_newline\}/\n/gm;
        $ra = m4_comma_split($cont);
        $cnt1 = scalar @{$ra};
        prt("${ind}MAC [$mac], with $cnt1 components...\n");
        $cnt1 = 0;
        foreach $itm (@{$ra}) {
            $cnt1++;
            $ditm = $itm;
            $ditm =~ s/\n/ /gm;
            if ($ditm =~ /^\[(.*)\]$/) {
                $itm = substr($itm,1,(length($itm)-2));
                $ditm = substr($ditm,1,(length($ditm)-2));
            }
            if ($itm =~ /^(\w+)\((.+)$/m) {
                $mac2 = $1;
                $cont2 = substr($itm,length($mac2)+1);
                prt( "${ind}$cnt1: as MAC2 [".$ditm."]\n");
                #$ra2 = m4_split_macro($rparams,$itm,($lev+1));
                $ra2 = m4_comma_split($cont2);
                $cnt2 = scalar @{$ra2};
                prt("${ind} MAC2 [$mac2] with $cnt2 components...\n");
                $cnt2 = 0;
                foreach $itm2 (@{$ra2}) {
                    $cnt2++;
                    $ditm = $itm2;
                    $ditm =~ s/\n/ /gm;
                    if ($ditm =~ /^\[(.*)\]$/m) {
                        $itm2 = substr($itm2,1,(length($itm2)-2));
                        $ditm = substr($ditm,1,(length($ditm)-2));
                    }
                    ### prt( "${ind}${ind}$cnt:$cnt2: [".$ditm."]\n");
                    if ($itm2 =~ /^(\w+)\((.+)$/m) {
                        $mac3 = $1;
                        $cont3 = substr($itm2,length($mac3)+1);
                        prt( "${ind}${ind}$cnt1:$cnt2: as MAC3 [$mac3] [".$ditm."]\n");
                        #$ra3 = m4_split_macro($rparams,$itm2,($lev+1));
                        $ra3 = m4_comma_split($cont3);
                        $cnt3 = scalar @{$ra3};
                        prt("${ind} MAC3 [$mac3] with $cnt3 components...\n");
                        $cnt3 = 0;
                        foreach $itm3 (@{$ra3}) {
                            $cnt3++;
                            $ditm = $itm3;
                            $ditm =~ s/\n/ /gm;
                            if ($ditm =~ /^\[(.*)\]$/m) {
                                $itm3 = substr($itm3,1,(length($itm3)-2));
                                $ditm = substr($ditm,1,(length($ditm)-2));
                            }
                            prt( "${ind}${ind}$cnt1:$cnt2:$cnt3: [".$ditm."]\n");
                        }
                    } else {
                        prt( "${ind}${ind}$cnt1:$cnt2: {".$ditm."}\n");
                    }
                }
            } else {
                prt( "${ind}$cnt1: {".$ditm."}\n");
            }
        }
    } else {
        $ra = \@arr;
        prt("\n${ind}NOT AN M4 MACRO [$line]\n");
        if ($line =~ /^(\w+)\(/) {
            $mac = $1;
            $cont = substr($line,(length($mac)+1));
            prt("${ind}Starts with [$mac] ok, but after [$cont]\n");
            if ($cont =~ /\)$/m) {
                prt("${ind}And ends ok with ')' - WHAT IS WRONG?\n");
            } else {
                prt("${ind}Does NOT END in ')'?\n");
            }   
        } else {
            prt("${ind}Does NOT start properly...\n");
        }
    }
    return $ra;
}

sub m4_split_macro_very_ok($$$) {
    my ($rparams,$oline,$lev) = @_;
    my ($mac,$cont,$ra,$cnt1,$itm);
    my ($mac2,$cont2,$ra2,$itm2,$cnt2);
    my ($mac3,$cont3,$ra3,$itm3,$cnt3);
    my ($dcont,$ditm);
    my $line = $oline;
    $line = remove_dnl($line);
    my $ind = ' ';
    $ind .= '   ' x $lev;
    my @arr = ();
    #$line =~ s/\n/\$\{m4_newline\}/gm;
    $cnt1 = 0;
    if ($line =~ /^(\w+)\((.+)$/m) {
        $mac = $1;
        #$cont = $2; # this excludes after a CR???
        $cont = substr($line,(length($mac)+1));
        $dcont = $cont;
        $dcont =~ s/\n/ /gm;
        prt("\n") if ($lev == 0);
        prt("${ind}GOOD MAC [$mac], with [$dcont]\n");
        #$cont =~ s/\$\{m4_newline\}/\n/gm;
        $ra = m4_comma_split($cont);
        $cnt1 = scalar @{$ra};
        prt("${ind}MAC [$mac], with $cnt1 components...\n");
        $cnt1 = 0;
        foreach $itm (@{$ra}) {
            $cnt1++;
            $ditm = $itm;
            $ditm =~ s/\n/ /gm;
            if ($ditm =~ /^\[(.*)\]$/) {
                $itm = substr($itm,1,(length($itm)-2));
                $ditm = substr($ditm,1,(length($ditm)-2));
            }
            if ($itm =~ /^(\w+)\((.+)$/m) {
                $mac2 = $1;
                prt( "${ind}$cnt1: as MAC2 [".$ditm."]\n");
                $ra2 = m4_split_macro($rparams,$itm,($lev+1));
                $cnt2 = scalar @{$ra2};
                prt("${ind} MAC2 [$mac2] with $cnt2 components...\n");
                $cnt2 = 0;
                foreach $itm2 (@{$ra2}) {
                    $cnt2++;
                    $ditm = $itm2;
                    $ditm =~ s/\n/ /gm;
                    if ($ditm =~ /^\[(.*)\]$/m) {
                        $itm2 = substr($itm2,1,(length($itm2)-2));
                        $ditm = substr($ditm,1,(length($ditm)-2));
                    }
                    ### prt( "${ind}${ind}$cnt:$cnt2: [".$ditm."]\n");
                    if ($itm2 =~ /^(\w+)\((.+)$/m) {
                        $mac3 = $1;
                        prt( "${ind}${ind}$cnt1:$cnt2: as MAC3 [$mac3] [".$ditm."]\n");
                        $ra3 = m4_split_macro($rparams,$itm2,($lev+1));
                        $cnt3 = scalar @{$ra3};
                        prt("${ind} MAC3 [$mac3] with $cnt3 components...\n");
                        $cnt3 = 0;
                        foreach $itm3 (@{$ra3}) {
                            $cnt3++;
                            $ditm = $itm3;
                            $ditm =~ s/\n/ /gm;
                            if ($ditm =~ /^\[(.*)\]$/m) {
                                $itm3 = substr($itm3,1,(length($itm3)-2));
                                $ditm = substr($ditm,1,(length($ditm)-2));
                            }
                            prt( "${ind}${ind}$cnt1:$cnt2:$cnt3: [".$ditm."]\n");
                        }
                    } else {
                        prt( "${ind}${ind}$cnt1:$cnt2: {".$ditm."}\n");
                    }
                }
            } else {
                prt( "${ind}$cnt1: {".$ditm."}\n");
            }
        }
    } else {
        $ra = \@arr;
        prt("\n${ind}NOT AN M4 MACRO [$line]\n");
        if ($line =~ /^(\w+)\(/) {
            $mac = $1;
            $cont = substr($line,(length($mac)+1));
            prt("${ind}Starts with [$mac] ok, but after [$cont]\n");
            if ($cont =~ /\)$/m) {
                prt("${ind}And ends ok with ')' - WHAT IS WRONG?\n");
            } else {
                prt("${ind}Does NOT END in ')'?\n");
            }   
        } else {
            prt("${ind}Does NOT start properly...\n");
        }
    }
    return $ra;
}


sub m4_split_macro_ok($$$) {
    my ($rparams,$oline,$lev) = @_;
    my ($mac,$cont,$ra,$cnt,$itm);
    my ($mac2,$cont2,$ra2,$itm2,$cnt2);
    my ($mac3,$cont3,$ra3,$itm3,$cnt3);
    my ($dcont,$ditm);
    my $line = $oline;
    $line = remove_dnl($line);
    my $ind = ' ';
    $ind .= '   ' x $lev;
    my @arr = ();
    #$line =~ s/\n/\$\{m4_newline\}/gm;
    if ($line =~ /^(\w+)\((.+)$/m) {
        $mac = $1;
        #$cont = $2; # this excludes after a CR???
        $cont = substr($line,(length($mac)+1));
        $dcont = $cont;
        $dcont =~ s/\n/ /gm;
        prt("\n") if ($lev == 0);
        prt("${ind}GOOD MAC [$mac], with [$dcont]\n");
        #$cont =~ s/\$\{m4_newline\}/\n/gm;
        $ra = m4_comma_split($cont);
        $cnt = scalar @{$ra};
        prt("${ind}MAC [$mac], with $cnt components...\n");
        $cnt = 0;
        foreach $itm (@{$ra}) {
            $cnt++;
            $ditm = $itm;
            $ditm =~ s/\n/ /gm;
            if ($ditm =~ /^\[(.*)\]$/) {
                $itm = substr($itm,1,(length($itm)-2));
            }
            prt( "${ind}$cnt: [".$ditm."]\n");
            if ($itm =~ /^(\w+)\((.+)$/m) {
                $ra2 = m4_split_macro($rparams,$itm,($lev+1));
                $cnt2 = 0;
                foreach $itm2 (@{$ra2}) {
                    $cnt2++;
                    $ditm = $itm2;
                    $ditm =~ s/\n/ /gm;
                    if ($ditm =~ /^\[.*\]$/m) {
                        $itm2 = substr($itm2,1,(length($itm2)-2));
                    }
                    prt( "${ind}${ind}$cnt:$cnt2: [".$ditm."]\n");
                    if ($itm2 =~ /^(\w+)\((.+)$/m) {
                        $ra3 = m4_split_macro($rparams,$itm2,($lev+1));
                        $cnt3 = 0;
                        foreach $itm3 (@{$ra3}) {
                            $cnt3++;
                            $ditm = $itm3;
                            $ditm =~ s/\n/ /gm;
                            if ($ditm =~ /^\[.*\]$/m) {
                                $itm3 = substr($itm3,1,(length($itm3)-2));
                            }
                            prt( "${ind}${ind}$cnt:$cnt2:$cnt3: [".$ditm."]\n");
                        }
                    }
                }
            }
        }
    } else {
        $ra = \@arr;
        prt("\n${ind}NOT AN M4 MACRO [$line]\n");
        if ($line =~ /^(\w+)\(/) {
            $mac = $1;
            $cont = substr($line,(length($mac)+1));
            prt("${ind}Starts with [$mac] ok, but after [$cont]\n");
            if ($cont =~ /\)$/m) {
                prt("${ind}And ends ok with ')' - WHAT IS WRONG?\n");
            } else {
                prt("${ind}Does NOT END in ')'?\n");
            }   
        } else {
            prt("${ind}Does NOT start properly...\n");
        }
    }
    return $ra;
}

sub m4_split_macro_nearly_ok($$$) {
    my ($rparams,$oline,$lev) = @_;
    my ($mac,$cont,$ra,$cnt,$itm);
    my ($mac2,$cont2,$ra2,$itm2,$cnt2);
    my ($mac3,$cont3,$ra3,$itm3,$cnt3);
    my $line = $oline;
    $line = remove_dnl($line);
    $line =~ s/\n/\$\{m4_newline\}/gm;
    my $ind = ' ';
    $ind .= '   ' x $lev;
    my @arr = ();
    if ($line =~ /^(\w+)\((.+)$/m) {
        $mac = $1;
        $cont = $2;
        prt("${ind}GOOD MAC [$mac], with [$cont]\n");
        $cont =~ s/\$\{m4_newline\}/\n/gm;
        $ra = m4_comma_split($cont);
        $cnt = scalar @{$ra};
        prt("${ind}MAC [$mac], with $cnt components...\n");
        $cnt = 0;
        foreach $itm (@{$ra}) {
            $cnt++;
            if ($itm =~ /^\[.*\]$/m) {
                $itm = substr($itm,1,(length($itm)-2));
                prt( "${ind}$cnt: [".$itm."]\n");
                if ($itm =~ /^(\w+)\((.+)$/m) {
                    $ra2 = m4_split_macro($rparams,$itm,($lev+1));
                    $cnt2 = 0;
                    foreach $itm2 (@{$ra2}) {
                        $cnt2++;
                        if ($itm2 =~ /^\[.*\]$/) {
                            $itm2 = substr($itm2,1,(length($itm2)-2));
                            prt( "${ind}$cnt:$cnt2: [".$itm2."]\n");
                            if ($itm2 =~ /^(\w+)\((.+)$/m) {
                                $ra3 = m4_split_macro($rparams,$itm2,($lev+1));
                                foreach $itm3 (@{$ra3}) {

                                }
                            }
                        } else {
                            prt( "${ind}$cnt:$cnt2: {".$itm2."}\n");
                        }
                    }
                }
            } else {
                prt( "${ind}$cnt: {".$itm."}\n");
            }
        }
    } else {
        $ra = \@arr;
        prt("\n${ind}NOT AN M4 MACRO [$line]\n");
        if ($line =~ /^(\w+)\(/) {
            $mac = $1;
            $cont = substr($line,(length($mac)+1));
            prt("${ind}Starts with [$mac] ok, but after [$cont]\n");
            if ($cont =~ /\)$/m) {
                prt("${ind}And ends ok with ')' - WHAT IS WRONG?\n");
            } else {
                prt("${ind}Does NOT END in ')'?\n");
            }   
        } else {
            prt("${ind}Does NOT start properly...\n");
        }
    }
    return $ra;
}


sub m4_process_file($) {
    my ($rparams) = @_;
    my $inf = ${$rparams}{'CURR_M4_FILE'};
    if (! open INF, "<$inf") {
        pgm_exit(1,"ERROR: Unable to open file [$inf]\n"); 
    }
    my @lines = <INF>;
    close INF;
    my $lncnt = scalar @lines;
    prt("Processing $lncnt lines, from [$inf]...\n");
    my ($cline,$inc,$lnn,$tline,$len,$i,$ln2,$ra,$cnt);
    for ($i = 0; $i < $lncnt; $i++) {
        $cline = $lines[$i];
        chomp $cline;
        $lnn = $i + 1;
        $tline = trim_all($cline);
        $len = length($tline);
        next if ($len == 0);
        next if ($cline =~ /^\s*dnl\s*/);
        if ($cline =~ /\\$/) {
            $cline = m4_accumulate_with_back($cline,$lncnt,\$i,\@lines);
        }
        if ($cline =~ /^\s*\w+\(.*$/) {
            $cline = m4_accumulate_ac_macro($cline,$lncnt,\$i,\@lines);
        }
        $ln2 = $i + 1;
        prt("\n $lnn-$ln2: {".$cline."}\n");
        $ra = m4_split_macro($rparams,$cline,0);
        $cnt = scalar @{$ra};
        if ($cnt == 4) {
        }
    }
}

sub setup_ref_params($) {
    my ($fil) = @_;
    my $rp = get_ref_params();
    ${$rp}{'CURR_M4_FILE'} = $fil;
    my %m4_macros = ();
    ${$rp}{'REF_M4_MACROS'} = \%m4_macros;
    my %m4_defines = ();
    ${$rp}{'REF_M4_DEFINES'} = \%m4_defines;

    return $rp;
}

#########################################
### MAIN ###
parse_args(@ARGV);

my $rh = setup_ref_params($in_file);

m4_process_file($rh);

pgm_exit(0,"Normal exit(0)");
########################################
sub give_help {
    prt("$pgmname: version 0.0.1 2010-09-11\n");
    prt("Usage: $pgmname [options] in-file\n");
    prt("Options:\n");
    prt(" --help (-h or -?) = This help, and exit 0.\n");
}
sub need_arg {
    my ($arg,@av) = @_;
    pgm_exit(1,"ERROR: [$arg] must have following argument!\n") if (!@av);
}

sub parse_args {
    my (@av) = @_;
    my ($arg,$sarg);
    while (@av) {
        $arg = $av[0];
        if ($arg =~ /^-/) {
            $sarg = substr($arg,1);
            $sarg = substr($sarg,1) while ($sarg =~ /^-/);
            if (($sarg =~ /^h/i)||($sarg eq '?')) {
                give_help();
                pgm_exit(0,"Help exit(0)");
            } else {
                pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n");
            }
        } else {
            $in_file = File::Spec->rel2abs($arg);
            prt("Set input to [$in_file]\n");
        }
        shift @av;
    }

    if ((length($in_file) ==  0) && $debug_on) {
        $in_file = File::Spec->rel2abs($def_file);
    }
    if (length($in_file) ==  0) {
        pgm_exit(1,"ERROR: No input files found in command!\n");
    }
    if (! -f $in_file) {
        pgm_exit(1,"ERROR: Unable to find in file [$in_file]! Check name, location...\n");
    }
}

# SOME HELP

# from : http://www.gnu.org/software/m4/manual/m4.html

# Character translation is done with translit: — Builtin: translit (string, chars, [replacement])
# Expands to string, with each character that occurs in chars translated into the character 
# from replacement with the same index. 

# The builtin dnl stands for “Discard to Next Line”: — Builtin: dnl
# All characters, up to and including the next newline, are discarded without 
# performing any macro expansion. A warning is issued if the end of the file is 
# encountered without a newline. The expansion of dnl is void. 

# eof - template.pl
