# $Id: LayoutRule.pm,v 1.5 2003/03/17 06:28:57 thor Exp $
#
# Tom Moertel <tom@moertel.com>
# Copyright (C) 2003 Tom Moertel.
# Licensed under the GNU General Public License.

package LayoutRule;

use Filter::Util::Call;
use constant { BLOCK_CLOSE => '}', STMT_CLOSE => ';' };

# special forms are those syntactical elements that can begin a line
# and yet DO NOT start a statement that must be ended with a semicolon

my %special_forms = map {$_=>1} '#', qw(
    { }
    if elsif else unless
    while until
    for foreach 
);


sub import {

    my ($self, $debugQ) = @_;
    my (@lblocks, $defining_blockQ);
    my $prev_line = "";

    filter_add( sub {

        my $status = filter_read();  # read a line to filter
        my $line = $_;

        if ($status > 0) {

            # got a new line of input; look for 1st non-whitespace char

            if ($line =~ /^(\s*?)(\S.*)/) {

                my ($active_col, $stmt) = (length $1, $2);

                # found first non-whitespace character, which defines
                # the active column

                # if we are defining a new block layout, remember this column

                if ($defining_blockQ) {
                    push @lblocks, [$active_col, BLOCK_CLOSE];
                    $defining_blockQ = 0;
                }

                # close any open layouts accordingly

                chomp $prev_line;
                $prev_line .= close_layouts_to_right(\@lblocks, $active_col);
                $prev_line .= " $/";

                # if we are defining a new statement layout, remember this col

                if (start_stmt_layoutQ(\@lblocks, $active_col, $stmt)) {
                    push @lblocks, [$active_col, STMT_CLOSE];
                }
                
                # see if we have opened any new layout blocks on this line

                unless ($line =~ /^\s*\#/) {  # unless this line is a comment
                while ($line =~ /^(.*? \{\| \s*)(\S.*)?/x) {

                    # we are opening a block; $2 marks char that
                    # defines block col *if* the block starts inline;
                    # otherwise we must enter defining-block mode to
                    # seek the block-defining char in future lines

                    if ( ! ($defining_blockQ = ! $2) ) {
                        ($active_col, $stmt) = (length $1, $2);
                        push @lblocks, [$active_col, BLOCK_CLOSE];
                        if (start_stmt_layoutQ(\@lblocks,$active_col,$stmt)) {
                            push @lblocks, [$active_col, STMT_CLOSE];
                        }
                    }
                    $line =~ s/^(.*?)\{\|/$1\{ /;  # change "{|" to "{ "
                }}
            }

            # output the previous line and save the current line
            ($prev_line, $_) = ($line, $prev_line);
        }

        elsif ($status == 0) {

            # end of input; output final line and close any open blocks

            if (@lblocks) {
                $_ = $prev_line . close_layouts_to_right(\@lblocks, -1) . $/;
                $status = 1;
            }
        }

        if ($debugQ) {
            if ($status) { print STDERR; }
            else         { exit 0;       }
        }

        return $status;
    })
}


sub close_layouts_to_right {
    my ($lblocks, $active_col) = @_;
    my $cumulative_close = "";
    while (@$lblocks) {
        my ($layout_col, $close_str) = @{$lblocks->[-1]};
        last if $active_col > $layout_col;
        if ($close_str eq BLOCK_CLOSE && $active_col == $layout_col) {
            last;
        } else {
            $cumulative_close .= ($close_str eq BLOCK_CLOSE ? " " : "")
                               . $close_str;
            --$#$lblocks;
        }
    }
    return $cumulative_close;
}

sub start_stmt_layoutQ {
    my ($lblocks, $active_col, $stmt) = @_;
    my $startQ = ! special_formQ($stmt);
    if (@$lblocks) {
        my ($layout_col, $close_str) = @{$lblocks->[-1]};
        $startQ &&= $close_str eq BLOCK_CLOSE;
    }
    return $startQ;
}

sub special_formQ {
    my ($stmt) = @_;
    my ($first, $second) = split ' ', $stmt;
    my $sfQ = defined $special_forms{$first}
            || $first =~ /:$/ &&
               (! $second || defined $special_forms{$second});
#    print STDERR "[($first, $second)->$sfQ] ";
    return $sfQ;
}

1;