+sub copy_spacing {
+ (my $res = shift) =~ tr/\t/ /c;
+ return $res;
+}
+
+sub line_stats {
+ my ($line) = @_;
+
+ # Drop the diff line leader and expand tabs
+ $line =~ s/^.//;
+ $line = expand_tabs($line);
+
+ # Pick the indent from the front of the line.
+ my ($white) = ($line =~ /^(\s*)/);
+
+ return (length($line), length($white));
+}
+
+my $sanitise_quote = '';
+
+sub sanitise_line_reset {
+ my ($in_comment) = @_;
+
+ if ($in_comment) {
+ $sanitise_quote = '*/';
+ } else {
+ $sanitise_quote = '';
+ }
+}
+sub sanitise_line {
+ my ($line) = @_;
+
+ my $res = '';
+ my $l = '';
+
+ my $qlen = 0;
+ my $off = 0;
+ my $c;
+
+ # Always copy over the diff marker.
+ $res = substr($line, 0, 1);
+
+ for ($off = 1; $off < length($line); $off++) {
+ $c = substr($line, $off, 1);
+
+ # Comments we are wacking completly including the begin
+ # and end, all to $;.
+ if ($sanitise_quote eq '' && substr($line, $off, 2) eq '/*') {
+ $sanitise_quote = '*/';
+
+ substr($res, $off, 2, "$;$;");
+ $off++;
+ next;
+ }
+ if ($sanitise_quote eq '*/' && substr($line, $off, 2) eq '*/') {
+ $sanitise_quote = '';
+ substr($res, $off, 2, "$;$;");
+ $off++;
+ next;
+ }
+ if ($sanitise_quote eq '' && substr($line, $off, 2) eq '//') {
+ $sanitise_quote = '//';
+
+ substr($res, $off, 2, $sanitise_quote);
+ $off++;
+ next;
+ }
+
+ # A \ in a string means ignore the next character.
+ if (($sanitise_quote eq "'" || $sanitise_quote eq '"') &&
+ $c eq "\\") {
+ substr($res, $off, 2, 'XX');
+ $off++;
+ next;
+ }
+ # Regular quotes.
+ if ($c eq "'" || $c eq '"') {
+ if ($sanitise_quote eq '') {
+ $sanitise_quote = $c;
+
+ substr($res, $off, 1, $c);
+ next;
+ } elsif ($sanitise_quote eq $c) {
+ $sanitise_quote = '';
+ }
+ }
+
+ #print "c<$c> SQ<$sanitise_quote>\n";
+ if ($off != 0 && $sanitise_quote eq '*/' && $c ne "\t") {
+ substr($res, $off, 1, $;);
+ } elsif ($off != 0 && $sanitise_quote eq '//' && $c ne "\t") {
+ substr($res, $off, 1, $;);
+ } elsif ($off != 0 && $sanitise_quote && $c ne "\t") {
+ substr($res, $off, 1, 'X');
+ } else {
+ substr($res, $off, 1, $c);
+ }
+ }
+
+ if ($sanitise_quote eq '//') {
+ $sanitise_quote = '';
+ }
+
+ # The pathname on a #include may be surrounded by '<' and '>'.
+ if ($res =~ /^.\s*\#\s*include\s+\<(.*)\>/) {
+ my $clean = 'X' x length($1);
+ $res =~ s@\<.*\>@<$clean>@;
+
+ # The whole of a #error is a string.
+ } elsif ($res =~ /^.\s*\#\s*(?:error|warning)\s+(.*)\b/) {
+ my $clean = 'X' x length($1);
+ $res =~ s@(\#\s*(?:error|warning)\s+).*@$1$clean@;
+ }
+
+ return $res;
+}
+
+sub ctx_statement_block {
+ my ($linenr, $remain, $off) = @_;
+ my $line = $linenr - 1;
+ my $blk = '';
+ my $soff = $off;
+ my $coff = $off - 1;
+ my $coff_set = 0;
+
+ my $loff = 0;
+
+ my $type = '';
+ my $level = 0;
+ my @stack = ();
+ my $p;
+ my $c;
+ my $len = 0;
+
+ my $remainder;
+ while (1) {
+ @stack = (['', 0]) if ($#stack == -1);
+
+ #warn "CSB: blk<$blk> remain<$remain>\n";
+ # If we are about to drop off the end, pull in more
+ # context.
+ if ($off >= $len) {
+ for (; $remain > 0; $line++) {
+ last if (!defined $lines[$line]);
+ next if ($lines[$line] =~ /^-/);
+ $remain--;
+ $loff = $len;
+ $blk .= $lines[$line] . "\n";
+ $len = length($blk);
+ $line++;
+ last;
+ }
+ # Bail if there is no further context.
+ #warn "CSB: blk<$blk> off<$off> len<$len>\n";
+ if ($off >= $len) {
+ last;
+ }
+ }
+ $p = $c;
+ $c = substr($blk, $off, 1);
+ $remainder = substr($blk, $off);
+
+ #warn "CSB: c<$c> type<$type> level<$level> remainder<$remainder> coff_set<$coff_set>\n";
+
+ # Handle nested #if/#else.
+ if ($remainder =~ /^#\s*(?:ifndef|ifdef|if)\s/) {
+ push(@stack, [ $type, $level ]);
+ } elsif ($remainder =~ /^#\s*(?:else|elif)\b/) {
+ ($type, $level) = @{$stack[$#stack - 1]};
+ } elsif ($remainder =~ /^#\s*endif\b/) {
+ ($type, $level) = @{pop(@stack)};
+ }
+
+ # Statement ends at the ';' or a close '}' at the
+ # outermost level.
+ if ($level == 0 && $c eq ';') {
+ last;
+ }
+
+ # An else is really a conditional as long as its not else if
+ if ($level == 0 && $coff_set == 0 &&
+ (!defined($p) || $p =~ /(?:\s|\}|\+)/) &&
+ $remainder =~ /^(else)(?:\s|{)/ &&
+ $remainder !~ /^else\s+if\b/) {
+ $coff = $off + length($1) - 1;
+ $coff_set = 1;
+ #warn "CSB: mark coff<$coff> soff<$soff> 1<$1>\n";
+ #warn "[" . substr($blk, $soff, $coff - $soff + 1) . "]\n";
+ }
+
+ if (($type eq '' || $type eq '(') && $c eq '(') {
+ $level++;
+ $type = '(';
+ }
+ if ($type eq '(' && $c eq ')') {
+ $level--;
+ $type = ($level != 0)? '(' : '';
+
+ if ($level == 0 && $coff < $soff) {
+ $coff = $off;
+ $coff_set = 1;
+ #warn "CSB: mark coff<$coff>\n";
+ }
+ }
+ if (($type eq '' || $type eq '{') && $c eq '{') {
+ $level++;
+ $type = '{';
+ }
+ if ($type eq '{' && $c eq '}') {
+ $level--;
+ $type = ($level != 0)? '{' : '';
+
+ if ($level == 0) {
+ last;
+ }
+ }
+ $off++;
+ }
+ # We are truly at the end, so shuffle to the next line.
+ if ($off == $len) {
+ $loff = $len + 1;
+ $line++;
+ $remain--;
+ }
+
+ my $statement = substr($blk, $soff, $off - $soff + 1);
+ my $condition = substr($blk, $soff, $coff - $soff + 1);
+
+ #warn "STATEMENT<$statement>\n";
+ #warn "CONDITION<$condition>\n";
+
+ #print "coff<$coff> soff<$off> loff<$loff>\n";
+
+ return ($statement, $condition,
+ $line, $remain + 1, $off - $loff + 1, $level);
+}
+
+sub statement_lines {
+ my ($stmt) = @_;
+
+ # Strip the diff line prefixes and rip blank lines at start and end.
+ $stmt =~ s/(^|\n)./$1/g;
+ $stmt =~ s/^\s*//;
+ $stmt =~ s/\s*$//;
+
+ my @stmt_lines = ($stmt =~ /\n/g);
+
+ return $#stmt_lines + 2;
+}
+
+sub statement_rawlines {
+ my ($stmt) = @_;
+
+ my @stmt_lines = ($stmt =~ /\n/g);
+
+ return $#stmt_lines + 2;
+}
+
+sub statement_block_size {
+ my ($stmt) = @_;
+
+ $stmt =~ s/(^|\n)./$1/g;
+ $stmt =~ s/^\s*{//;
+ $stmt =~ s/}\s*$//;
+ $stmt =~ s/^\s*//;
+ $stmt =~ s/\s*$//;
+
+ my @stmt_lines = ($stmt =~ /\n/g);
+ my @stmt_statements = ($stmt =~ /;/g);
+
+ my $stmt_lines = $#stmt_lines + 2;
+ my $stmt_statements = $#stmt_statements + 1;
+
+ if ($stmt_lines > $stmt_statements) {
+ return $stmt_lines;
+ } else {
+ return $stmt_statements;
+ }
+}
+
+sub ctx_statement_full {
+ my ($linenr, $remain, $off) = @_;
+ my ($statement, $condition, $level);
+
+ my (@chunks);
+
+ # Grab the first conditional/block pair.
+ ($statement, $condition, $linenr, $remain, $off, $level) =
+ ctx_statement_block($linenr, $remain, $off);
+ #print "F: c<$condition> s<$statement> remain<$remain>\n";
+ push(@chunks, [ $condition, $statement ]);
+ if (!($remain > 0 && $condition =~ /^\s*(?:\n[+-])?\s*(?:if|else|do)\b/s)) {
+ return ($level, $linenr, @chunks);
+ }
+
+ # Pull in the following conditional/block pairs and see if they
+ # could continue the statement.
+ for (;;) {
+ ($statement, $condition, $linenr, $remain, $off, $level) =
+ ctx_statement_block($linenr, $remain, $off);
+ #print "C: c<$condition> s<$statement> remain<$remain>\n";
+ last if (!($remain > 0 && $condition =~ /^(?:\s*\n[+-])*\s*(?:else|do)\b/s));
+ #print "C: push\n";
+ push(@chunks, [ $condition, $statement ]);
+ }
+
+ return ($level, $linenr, @chunks);
+}
+
+sub ctx_block_get {
+ my ($linenr, $remain, $outer, $open, $close, $off) = @_;
+ my $line;
+ my $start = $linenr - 1;
+ my $blk = '';
+ my @o;
+ my @c;
+ my @res = ();
+
+ my $level = 0;
+ my @stack = ($level);
+ for ($line = $start; $remain > 0; $line++) {
+ next if ($rawlines[$line] =~ /^-/);
+ $remain--;
+
+ $blk .= $rawlines[$line];
+
+ # Handle nested #if/#else.
+ if ($rawlines[$line] =~ /^.\s*#\s*(?:ifndef|ifdef|if)\s/) {
+ push(@stack, $level);
+ } elsif ($rawlines[$line] =~ /^.\s*#\s*(?:else|elif)\b/) {
+ $level = $stack[$#stack - 1];
+ } elsif ($rawlines[$line] =~ /^.\s*#\s*endif\b/) {
+ $level = pop(@stack);
+ }
+
+ foreach my $c (split(//, $rawlines[$line])) {
+ ##print "C<$c>L<$level><$open$close>O<$off>\n";
+ if ($off > 0) {
+ $off--;
+ next;
+ }
+
+ if ($c eq $close && $level > 0) {
+ $level--;
+ last if ($level == 0);
+ } elsif ($c eq $open) {
+ $level++;
+ }
+ }
+
+ if (!$outer || $level <= 1) {
+ push(@res, $rawlines[$line]);
+ }
+
+ last if ($level == 0);
+ }
+
+ return ($level, @res);
+}
+sub ctx_block_outer {
+ my ($linenr, $remain) = @_;
+
+ my ($level, @r) = ctx_block_get($linenr, $remain, 1, '{', '}', 0);
+ return @r;
+}
+sub ctx_block {
+ my ($linenr, $remain) = @_;
+
+ my ($level, @r) = ctx_block_get($linenr, $remain, 0, '{', '}', 0);
+ return @r;
+}
+sub ctx_statement {
+ my ($linenr, $remain, $off) = @_;
+
+ my ($level, @r) = ctx_block_get($linenr, $remain, 0, '(', ')', $off);
+ return @r;
+}
+sub ctx_block_level {
+ my ($linenr, $remain) = @_;
+
+ return ctx_block_get($linenr, $remain, 0, '{', '}', 0);
+}
+sub ctx_statement_level {
+ my ($linenr, $remain, $off) = @_;
+
+ return ctx_block_get($linenr, $remain, 0, '(', ')', $off);
+}
+
+sub ctx_locate_comment {
+ my ($first_line, $end_line) = @_;
+
+ # Catch a comment on the end of the line itself.
+ my ($current_comment) = ($rawlines[$end_line - 1] =~ m@.*(/\*.*\*/)\s*(?:\\\s*)?$@);
+ return $current_comment if (defined $current_comment);
+
+ # Look through the context and try and figure out if there is a
+ # comment.
+ my $in_comment = 0;
+ $current_comment = '';
+ for (my $linenr = $first_line; $linenr < $end_line; $linenr++) {
+ my $line = $rawlines[$linenr - 1];
+ #warn " $line\n";
+ if ($linenr == $first_line and $line =~ m@^.\s*\*@) {
+ $in_comment = 1;
+ }
+ if ($line =~ m@/\*@) {
+ $in_comment = 1;
+ }
+ if (!$in_comment && $current_comment ne '') {
+ $current_comment = '';
+ }
+ $current_comment .= $line . "\n" if ($in_comment);
+ if ($line =~ m@\*/@) {
+ $in_comment = 0;
+ }
+ }
+
+ chomp($current_comment);
+ return($current_comment);
+}
+sub ctx_has_comment {
+ my ($first_line, $end_line) = @_;
+ my $cmt = ctx_locate_comment($first_line, $end_line);
+
+ ##print "LINE: $rawlines[$end_line - 1 ]\n";
+ ##print "CMMT: $cmt\n";
+
+ return ($cmt ne '');
+}
+
+sub raw_line {
+ my ($linenr, $cnt) = @_;
+
+ my $offset = $linenr - 1;
+ $cnt++;
+
+ my $line;
+ while ($cnt) {
+ $line = $rawlines[$offset++];
+ next if (defined($line) && $line =~ /^-/);
+ $cnt--;
+ }
+
+ return $line;
+}