Gecko [ edgpens.lpkmn.gov.my ]

Name	Size	Permission
VerticalAligner	[ DIR ]	drwxrwxrwx
Debugger.pm	3.5 KB	-rw-rw-rw-
DevNull.pm	391 B	-rw-rw-rw-
Diagnostics.pm	1.92 KB	-rw-rw-rw-
FileWriter.pm	6.84 KB	-rw-rw-rw-
Formatter.pm	672.95 KB	-rw-rw-rw-
HtmlWriter.pm	48.41 KB	-rw-rw-rw-
IOScalar.pm	2.61 KB	-rw-rw-rw-
IOScalarArray.pm	2.16 KB	-rw-rw-rw-
IndentationItem.pm	6.87 KB	-rw-rw-rw-
LineBuffer.pm	1.48 KB	-rw-rw-rw-
LineSink.pm	2.58 KB	-rw-rw-rw-
LineSource.pm	2.81 KB	-rw-rw-rw-
Logger.pm	17.13 KB	-rw-rw-rw-
Tokenizer.pm	286.9 KB	-rw-rw-rw-
VerticalAligner.pm	149.48 KB	-rw-rw-rw-

Code Editor : VerticalAligner.pm

package Perl::Tidy::VerticalAligner;
use strict;
use warnings;
our $VERSION = '20200619';

use Perl::Tidy::VerticalAligner::Alignment;
use Perl::Tidy::VerticalAligner::Line;

# The Perl::Tidy::VerticalAligner package collects output lines and
# attempts to line up certain common tokens, such as => and #, which are
# identified by the calling routine.
#
# There are two main routines: valign_input and flush.  Append acts as a
# storage buffer, collecting lines into a group which can be vertically
# aligned.  When alignment is no longer possible or desirable, it dumps
# the group to flush.
#
#     valign_input -----> flush
#
#     collects          writes
#     vertical          one
#     groups            group

BEGIN {

# Caution: these debug flags produce a lot of output
    # They should all be 0 except when debugging small scripts

use constant VALIGN_DEBUG_FLAG_APPEND  => 0;
    use constant VALIGN_DEBUG_FLAG_APPEND0 => 0;
    use constant VALIGN_DEBUG_FLAG_TERNARY => 0;
    use constant VALIGN_DEBUG_FLAG_TABS    => 0;

my $debug_warning = sub {
        print STDOUT "VALIGN_DEBUGGING with key $_[0]\n";
        return;
    };

VALIGN_DEBUG_FLAG_APPEND  && $debug_warning->('APPEND');
    VALIGN_DEBUG_FLAG_APPEND0 && $debug_warning->('APPEND0');
    VALIGN_DEBUG_FLAG_TERNARY && $debug_warning->('TERNARY');
    VALIGN_DEBUG_FLAG_TABS    && $debug_warning->('TABS');

}

use vars qw(
  $vertical_aligner_self
  $maximum_alignment_index
  $ralignment_list
  $maximum_jmax_seen
  $minimum_jmax_seen
  $previous_minimum_jmax_seen
  $previous_maximum_jmax_seen
  @group_lines
  $group_level
  $group_type
  $group_maximum_gap
  $marginal_match
  $last_level_written
  $last_leading_space_count
  $extra_indent_ok
  $zero_count
  $last_comment_column
  $last_side_comment_line_number
  $last_side_comment_length
  $last_side_comment_level
  $outdented_line_count
  $first_outdented_line_at
  $last_outdented_line_at
  $diagnostics_object
  $logger_object
  $file_writer_object
  @side_comment_history
  $comment_leading_space_count
  $is_matching_terminal_line
  $consecutive_block_comments

$cached_line_text
  $cached_line_text_length
  $cached_line_type
  $cached_line_flag
  $cached_seqno
  $cached_line_valid
  $cached_line_leading_space_count
  $cached_seqno_string

$valign_buffer_filling
  @valign_buffer

$seqno_string
  $last_nonblank_seqno_string

$rOpts

$rOpts_maximum_line_length
  $rOpts_variable_maximum_line_length
  $rOpts_continuation_indentation
  $rOpts_indent_columns
  $rOpts_tabs
  $rOpts_entab_leading_whitespace
  $rOpts_valign

$rOpts_fixed_position_side_comment
  $rOpts_minimum_space_to_comment

);

sub initialize {

my ( $class, @args ) = @_;

my %defaults = (
        rOpts              => undef,
        file_writer_object => undef,
        logger_object      => undef,
        diagnostics_object => undef,
        length_function    => sub { return length( $_[0] ) },
    );
    my %args = ( %defaults, @args );

$rOpts              = $args{rOpts};
    $file_writer_object = $args{file_writer_object};
    $logger_object      = $args{logger_object};
    $diagnostics_object = $args{diagnostics_object};
    my $length_function = $args{length_function};

# variables describing the entire space group:
    $ralignment_list            = [];
    $group_level                = 0;
    $last_level_written         = -1;
    $extra_indent_ok            = 0;    # can we move all lines to the right?
    $last_side_comment_length   = 0;
    $maximum_jmax_seen          = 0;
    $minimum_jmax_seen          = 0;
    $previous_minimum_jmax_seen = 0;
    $previous_maximum_jmax_seen = 0;

# variables describing each line of the group
    @group_lines = ();                  # list of all lines in group

$outdented_line_count          = 0;
    $first_outdented_line_at       = 0;
    $last_outdented_line_at        = 0;
    $last_side_comment_line_number = 0;
    $last_side_comment_level       = -1;
    $is_matching_terminal_line     = 0;

# most recent 3 side comments; [ line number, column ]
    $side_comment_history[0] = [ -300, 0 ];
    $side_comment_history[1] = [ -200, 0 ];
    $side_comment_history[2] = [ -100, 0 ];

# valign_output_step_B cache:
    $cached_line_text                = "";
    $cached_line_text_length         = 0;
    $cached_line_type                = 0;
    $cached_line_flag                = 0;
    $cached_seqno                    = 0;
    $cached_line_valid               = 0;
    $cached_line_leading_space_count = 0;
    $cached_seqno_string             = "";

# string of sequence numbers joined together
    $seqno_string               = "";
    $last_nonblank_seqno_string = "";

# frequently used parameters
    $rOpts_indent_columns           = $rOpts->{'indent-columns'};
    $rOpts_tabs                     = $rOpts->{'tabs'};
    $rOpts_entab_leading_whitespace = $rOpts->{'entab-leading-whitespace'};
    $rOpts_fixed_position_side_comment =
      $rOpts->{'fixed-position-side-comment'};
    $rOpts_minimum_space_to_comment = $rOpts->{'minimum-space-to-comment'};
    $rOpts_maximum_line_length      = $rOpts->{'maximum-line-length'};
    $rOpts_variable_maximum_line_length =
      $rOpts->{'variable-maximum-line-length'};
    $rOpts_valign = $rOpts->{'valign'};

$consecutive_block_comments = 0;
    forget_side_comment();

initialize_for_new_group();

$vertical_aligner_self = { length_function => $length_function, };
    bless $vertical_aligner_self, $class;
    return $vertical_aligner_self;
}

sub initialize_for_new_group {
    @group_lines                 = ();
    $maximum_alignment_index     = -1;  # alignments in current group
    $zero_count                  = 0;   # count consecutive lines without tokens
    $group_maximum_gap           = 0;   # largest gap introduced
    $group_type                  = "";
    $marginal_match              = 0;
    $comment_leading_space_count = 0;
    $last_leading_space_count    = 0;
    return;
}

# interface to Perl::Tidy::Diagnostics routines
sub write_diagnostics {
    my $msg = shift;
    if ($diagnostics_object) {
        $diagnostics_object->write_diagnostics($msg);
    }
    return;
}

# interface to Perl::Tidy::Logger routines
sub warning {
    my ($msg) = @_;
    if ($logger_object) {
        $logger_object->warning($msg);
    }
    return;
}

sub write_logfile_entry {
    my ($msg) = @_;
    if ($logger_object) {
        $logger_object->write_logfile_entry($msg);
    }
    return;
}

sub report_definite_bug {
    if ($logger_object) {
        $logger_object->report_definite_bug();
    }
    return;
}

sub get_cached_line_count {
    my $self = shift;
    return @group_lines + ( $cached_line_type ? 1 : 0 );
}

sub get_spaces {

# return the number of leading spaces associated with an indentation
    # variable $indentation is either a constant number of spaces or an
    # object with a get_spaces method.
    my $indentation = shift;
    return ref($indentation) ? $indentation->get_spaces() : $indentation;
}

sub get_recoverable_spaces {

# return the number of spaces (+ means shift right, - means shift left)
    # that we would like to shift a group of lines with the same indentation
    # to get them to line up with their opening parens
    my $indentation = shift;
    return ref($indentation) ? $indentation->get_recoverable_spaces() : 0;
}

sub get_stack_depth {

my $indentation = shift;
    return ref($indentation) ? $indentation->get_stack_depth() : 0;
}

sub make_alignment {
    my ( $col, $token ) = @_;

# make one new alignment at column $col which aligns token $token
    ++$maximum_alignment_index;

#my $alignment = new Perl::Tidy::VerticalAligner::Alignment(
    my $nlines    = @group_lines;
    my $alignment = Perl::Tidy::VerticalAligner::Alignment->new(
        column          => $col,
        starting_column => $col,
        matching_token  => $token,
        starting_line   => $nlines - 1,
        ending_line     => $nlines - 1,
        serial_number   => $maximum_alignment_index,
    );
    $ralignment_list->[$maximum_alignment_index] = $alignment;
    return $alignment;
}

sub dump_alignments {
    print STDOUT
"Current Alignments:\ni\ttoken\tstarting_column\tcolumn\tstarting_line\tending_line\n";
    for my $i ( 0 .. $maximum_alignment_index ) {
        my $column          = $ralignment_list->[$i]->get_column();
        my $starting_column = $ralignment_list->[$i]->get_starting_column();
        my $matching_token  = $ralignment_list->[$i]->get_matching_token();
        my $starting_line   = $ralignment_list->[$i]->get_starting_line();
        my $ending_line     = $ralignment_list->[$i]->get_ending_line();
        print STDOUT
"$i\t$matching_token\t$starting_column\t$column\t$starting_line\t$ending_line\n";
    }
    return;
}

sub save_alignment_columns {
    for my $i ( 0 .. $maximum_alignment_index ) {
        $ralignment_list->[$i]->save_column();
    }
    return;
}

sub restore_alignment_columns {
    for my $i ( 0 .. $maximum_alignment_index ) {
        $ralignment_list->[$i]->restore_column();
    }
    return;
}

sub forget_side_comment {
    $last_comment_column = 0;
    return;
}

sub maximum_line_length_for_level {

# return maximum line length for line starting with a given level
    my $maximum_line_length = $rOpts_maximum_line_length;
    if ($rOpts_variable_maximum_line_length) {
        my $level = shift;
        if ( $level < 0 ) { $level = 0 }
        $maximum_line_length += $level * $rOpts_indent_columns;
    }
    return $maximum_line_length;
}

sub push_group_line {

my ($new_line) = @_;
    push @group_lines, $new_line;
    return;
}

sub valign_input {

# Place one line in the current vertical group.
    #
    # The input parameters are:
    #     $level = indentation level of this line
    #     $rfields = reference to array of fields
    #     $rpatterns = reference to array of patterns, one per field
    #     $rtokens   = reference to array of tokens starting fields 1,2,..
    #
    # Here is an example of what this package does.  In this example,
    # we are trying to line up both the '=>' and the '#'.
    #
    #         '18' => 'grave',    #   \`
    #         '19' => 'acute',    #   `'
    #         '20' => 'caron',    #   \v
    # <-tabs-><f1-><--field 2 ---><-f3->
    # |            |              |    |
    # |            |              |    |
    # col1        col2         col3 col4
    #
    # The calling routine has already broken the entire line into 3 fields as
    # indicated.  (So the work of identifying promising common tokens has
    # already been done).
    #
    # In this example, there will be 2 tokens being matched: '=>' and '#'.
    # They are the leading parts of fields 2 and 3, but we do need to know
    # what they are so that we can dump a group of lines when these tokens
    # change.
    #
    # The fields contain the actual characters of each field.  The patterns
    # are like the fields, but they contain mainly token types instead
    # of tokens, so they have fewer characters.  They are used to be
    # sure we are matching fields of similar type.
    #
    # In this example, there will be 4 column indexes being adjusted.  The
    # first one is always at zero.  The interior columns are at the start of
    # the matching tokens, and the last one tracks the maximum line length.
    #
    # Each time a new line comes in, it joins the current vertical
    # group if possible.  Otherwise it causes the current group to be dumped
    # and a new group is started.
    #
    # For each new group member, the column locations are increased, as
    # necessary, to make room for the new fields.  When the group is finally
    # output, these column numbers are used to compute the amount of spaces of
    # padding needed for each field.
    #
    # Programming note: the fields are assumed not to have any tab characters.
    # Tabs have been previously removed except for tabs in quoted strings and
    # side comments.  Tabs in these fields can mess up the column counting.
    # The log file warns the user if there are any such tabs.

my ($rline_hash) = @_;

my $level                     = $rline_hash->{level};
    my $level_end                 = $rline_hash->{level_end};
    my $indentation               = $rline_hash->{indentation};
    my $is_forced_break           = $rline_hash->{is_forced_break};
    my $outdent_long_lines        = $rline_hash->{outdent_long_lines};
    my $is_terminal_ternary       = $rline_hash->{is_terminal_ternary};
    my $is_terminal_statement     = $rline_hash->{is_terminal_statement};
    my $do_not_pad                = $rline_hash->{do_not_pad};
    my $rvertical_tightness_flags = $rline_hash->{rvertical_tightness_flags};
    my $level_jump                = $rline_hash->{level_jump};
    my $rfields                   = $rline_hash->{rfields};
    my $rtokens                   = $rline_hash->{rtokens};
    my $rpatterns                 = $rline_hash->{rpatterns};
    my $rfield_lengths            = $rline_hash->{rfield_lengths};

# number of fields is $jmax
    # number of tokens between fields is $jmax-1
    my $jmax = @{$rfields} - 1;

my $leading_space_count = get_spaces($indentation);

# set outdented flag to be sure we either align within statements or
    # across statement boundaries, but not both.
    my $is_outdented = $last_leading_space_count > $leading_space_count;
    $last_leading_space_count = $leading_space_count;

# Patch: undo for hanging side comment
    my $is_hanging_side_comment =
      ( $jmax == 1 && $rtokens->[0] eq '#' && $rfields->[0] =~ /^\s*$/ );
    $is_outdented = 0 if $is_hanging_side_comment;

# Forget side comment alignment after seeing 2 or more block comments
    my $is_block_comment = ( $jmax == 0 && $rfields->[0] =~ /^#/ );
    if ($is_block_comment) {
        $consecutive_block_comments++;
    }
    else {
        if ( $consecutive_block_comments > 1 ) { forget_side_comment() }
        $consecutive_block_comments = 0;
    }

VALIGN_DEBUG_FLAG_APPEND0 && do {
        my $nlines = @group_lines;
        print STDOUT
"APPEND0: entering lines=$nlines new #fields= $jmax, leading_count=$leading_space_count last_cmt=$last_comment_column force=$is_forced_break, level_jump=$level_jump, level=$level, group_level=$group_level, level_jump=$level_jump\n";
    };

# Validate cached line if necessary: If we can produce a container
    # with just 2 lines total by combining an existing cached opening
    # token with the closing token to follow, then we will mark both
    # cached flags as valid.
    if ($rvertical_tightness_flags) {
        if (   @group_lines <= 1
            && $cached_line_type
            && $cached_seqno
            && $rvertical_tightness_flags->[2]
            && $rvertical_tightness_flags->[2] == $cached_seqno )
        {
            $rvertical_tightness_flags->[3] ||= 1;
            $cached_line_valid ||= 1;
        }
    }

# do not join an opening block brace with an unbalanced line
    # unless requested with a flag value of 2
    if (   $cached_line_type == 3
        && !@group_lines
        && $cached_line_flag < 2
        && $level_jump != 0 )
    {
        $cached_line_valid = 0;
    }

# patch until new aligner is finished
    if ($do_not_pad) { my_flush() }

# shouldn't happen:
    if ( $level < 0 ) { $level = 0 }

# do not align code across indentation level changes
    # or if vertical alignment is turned off for debugging
    if ( $level != $group_level || $is_outdented || !$rOpts_valign ) {

# we are allowed to shift a group of lines to the right if its
        # level is greater than the previous and next group
        $extra_indent_ok =
          ( $level < $group_level && $last_level_written < $group_level );

my_flush();

# If we know that this line will get flushed out by itself because
        # of level changes, we can leave the extra_indent_ok flag set.
        # That way, if we get an external flush call, we will still be
        # able to do some -lp alignment if necessary.
        $extra_indent_ok = ( $is_terminal_statement && $level > $group_level );

$group_level = $level;

# wait until after the above flush to get the leading space
        # count because it may have been changed if the -icp flag is in
        # effect
        $leading_space_count = get_spaces($indentation);

}

# --------------------------------------------------------------------
    # Collect outdentable block COMMENTS
    # --------------------------------------------------------------------
    my $is_blank_line = "";
    if ( $group_type eq 'COMMENT' ) {
        if (
            (
                   $is_block_comment
                && $outdent_long_lines
                && $leading_space_count == $comment_leading_space_count
            )
            || $is_blank_line
          )
        {
            push_group_line( [ $rfields->[0], $rfield_lengths->[0] ] );
            return;
        }
        else {
            my_flush();
        }
    }

# --------------------------------------------------------------------
    # add dummy fields for terminal ternary
    # --------------------------------------------------------------------
    my $j_terminal_match;

if ( $is_terminal_ternary && @group_lines ) {
        $j_terminal_match = fix_terminal_ternary(
            $group_lines[-1], $rfields, $rtokens,
            $rpatterns,       $rfield_lengths
        );
        $jmax = @{$rfields} - 1;
    }

# --------------------------------------------------------------------
    # add dummy fields for else statement
    # --------------------------------------------------------------------

if (   $rfields->[0] =~ /^else\s*$/
        && @group_lines
        && $level_jump == 0 )
    {

$j_terminal_match = fix_terminal_else(
            $group_lines[-1], $rfields, $rtokens,
            $rpatterns,       $rfield_lengths
        );
        $jmax = @{$rfields} - 1;
    }

# --------------------------------------------------------------------
    # Handle simple line of code with no fields to match.
    # --------------------------------------------------------------------
    if ( $jmax <= 0 ) {
        $zero_count++;

if ( @group_lines
            && !get_recoverable_spaces( $group_lines[0]->get_indentation() ) )
        {

# flush the current group if it has some aligned columns..
            if ( $group_lines[0]->get_jmax() > 1 ) { my_flush() }

# flush current group if we are just collecting side comments..
            elsif (

# ...and we haven't seen a comment lately
                ( $zero_count > 3 )

# ..or if this new line doesn't fit to the left of the comments
                || ( ( $leading_space_count + $rfield_lengths->[0] ) >
                    $group_lines[0]->get_column(0) )
              )
            {
                my_flush();
            }
        }

# start new COMMENT group if this comment may be outdented
        if (   $is_block_comment
            && $outdent_long_lines
            && !@group_lines )
        {
            $group_type                  = 'COMMENT';
            $comment_leading_space_count = $leading_space_count;
            push_group_line( [ $rfields->[0], $rfield_lengths->[0] ] );
            return;
        }

# just write this line directly if no current group, no side comment,
        # and no space recovery is needed.
        if ( !@group_lines && !get_recoverable_spaces($indentation) ) {

valign_output_step_B(
                leading_space_count       => $leading_space_count,
                line                      => $rfields->[0],
                line_length               => $rfield_lengths->[0],
                side_comment_length       => 0,
                outdent_long_lines        => $outdent_long_lines,
                rvertical_tightness_flags => $rvertical_tightness_flags,
                level                     => $level
            );

return;
        }
    }
    else {
        $zero_count = 0;
    }

# programming check: (shouldn't happen)
    # an error here implies an incorrect call was made
    if ( @{$rfields} && ( @{$rtokens} != ( @{$rfields} - 1 ) ) ) {
        my $nt = @{$rtokens};
        my $nf = @{$rfields};
        warning(
"Program bug in Perl::Tidy::VerticalAligner - number of tokens = $nt should be one less than number of fields: $nf)\n"
        );
        report_definite_bug();
    }
    my $maximum_line_length_for_level = maximum_line_length_for_level($level);

# --------------------------------------------------------------------
    # create an object to hold this line
    # --------------------------------------------------------------------
    my $new_line = Perl::Tidy::VerticalAligner::Line->new(
        jmax                      => $jmax,
        jmax_original_line        => $jmax,
        rtokens                   => $rtokens,
        rfields                   => $rfields,
        rpatterns                 => $rpatterns,
        rfield_lengths            => $rfield_lengths,
        indentation               => $indentation,
        leading_space_count       => $leading_space_count,
        outdent_long_lines        => $outdent_long_lines,
        list_type                 => "",
        is_hanging_side_comment   => $is_hanging_side_comment,
        maximum_line_length       => $maximum_line_length_for_level,
        rvertical_tightness_flags => $rvertical_tightness_flags,
        is_terminal_ternary       => $is_terminal_ternary,
        j_terminal_match          => $j_terminal_match,
        is_forced_break           => $is_forced_break,
    );

# --------------------------------------------------------------------
    # It simplifies things to create a zero length side comment
    # if none exists.
    # --------------------------------------------------------------------
    make_side_comment( $new_line, $level_end );

# --------------------------------------------------------------------
    # Decide if this is a simple list of items.
    # There are 3 list types: none, comma, comma-arrow.
    # We use this below to be less restrictive in deciding what to align.
    # --------------------------------------------------------------------
    if ($is_forced_break) {
        decide_if_list($new_line);
    }

# --------------------------------------------------------------------
    # Append this line to the current group (or start new group)
    # --------------------------------------------------------------------
    if ( !@group_lines ) {
        add_to_group($new_line);
    }
    else {
        push_group_line($new_line);
    }

# output this group if it ends in a terminal else or ternary line
    if ( defined($j_terminal_match) ) {
        my_flush();
    }

# Force break after jump to lower level
    if ( $level_jump < 0 ) {
        my_flush();
    }

# --------------------------------------------------------------------
    # Some old debugging stuff
    # --------------------------------------------------------------------
    VALIGN_DEBUG_FLAG_APPEND && do {
        print STDOUT "APPEND fields:";
        dump_array( @{$rfields} );
        print STDOUT "APPEND tokens:";
        dump_array( @{$rtokens} );
        print STDOUT "APPEND patterns:";
        dump_array( @{$rpatterns} );
        dump_alignments();
    };

return;
}

sub join_hanging_comment {

my $line = shift;
    my $jmax = $line->get_jmax();
    return 0 unless $jmax == 1;    # must be 2 fields
    my $rtokens = $line->get_rtokens();
    return 0 unless $rtokens->[0] eq '#';    # the second field is a comment..
    my $rfields = $line->get_rfields();
    return 0 unless $rfields->[0] =~ /^\s*$/;    # the first field is empty...
    my $old_line            = shift;
    my $maximum_field_index = $old_line->get_jmax();
    return 0
      unless $maximum_field_index > $jmax;    # the current line has more fields
    my $rpatterns      = $line->get_rpatterns();
    my $rfield_lengths = $line->get_rfield_lengths();

$line->set_is_hanging_side_comment(1);
    $jmax = $maximum_field_index;
    $line->set_jmax($jmax);
    $rfields->[$jmax]         = $rfields->[1];
    $rfield_lengths->[$jmax]  = $rfield_lengths->[1];
    $rtokens->[ $jmax - 1 ]   = $rtokens->[0];
    $rpatterns->[ $jmax - 1 ] = $rpatterns->[0];
    foreach my $j ( 1 .. $jmax - 1 ) {
        $rfields->[$j]         = " "; # NOTE: caused glitch unless 1 blank, why?
        $rfield_lengths->[$j]  = 1;
        $rtokens->[ $j - 1 ]   = "";
        $rpatterns->[ $j - 1 ] = "";
    }
    return 1;
}

sub eliminate_old_fields {

my $new_line = shift;
    my $jmax     = $new_line->get_jmax();
    if ( $jmax > $maximum_jmax_seen ) { $maximum_jmax_seen = $jmax }
    if ( $jmax < $minimum_jmax_seen ) { $minimum_jmax_seen = $jmax }

# there must be one previous line
    return unless ( @group_lines == 1 );

my $old_line            = shift;
    my $maximum_field_index = $old_line->get_jmax();

###############################################
    # Moved below to allow new coding for => matches
    # return unless $maximum_field_index > $jmax;
    ###############################################

# Identify specific cases where field elimination is allowed:
    # case=1: both lines have comma-separated lists, and the first
    #         line has an equals
    # case=2: both lines have leading equals

# case 1 is the default
    my $case = 1;

# See if case 2: both lines have leading '='
    # We'll require similar leading patterns in this case
    my $old_rtokens   = $old_line->get_rtokens();
    my $rtokens       = $new_line->get_rtokens();
    my $rpatterns     = $new_line->get_rpatterns();
    my $old_rpatterns = $old_line->get_rpatterns();
    if (   $rtokens->[0] =~ /^=>?\d*$/
        && $old_rtokens->[0] eq $rtokens->[0]
        && $old_rpatterns->[0] eq $rpatterns->[0] )
    {
        $case = 2;
    }

# not too many fewer fields in new line for case 1
    return unless ( $case != 1 || $maximum_field_index - 2 <= $jmax );

# case 1 must have side comment
    my $old_rfields        = $old_line->get_rfields();
    my $old_rfield_lengths = $old_line->get_rfield_lengths();
    return
      if ( $case == 1
        && length( $old_rfields->[$maximum_field_index] ) == 0 );

my $rfields        = $new_line->get_rfields();
    my $rfield_lengths = $new_line->get_rfield_lengths();

my $hid_equals = 0;

my @new_alignments        = ();
    my @new_fields            = ();
    my @new_field_lengths     = ();
    my @new_matching_patterns = ();
    my @new_matching_tokens   = ();

my $j                    = 0;
    my $current_field        = '';
    my $current_field_length = 0;
    my $current_pattern      = '';

# loop over all old tokens
    my $in_match = 0;
    foreach my $k ( 0 .. $maximum_field_index - 1 ) {
        $current_field .= $old_rfields->[$k];
        $current_field_length += $old_rfield_lengths->[$k];
        $current_pattern .= $old_rpatterns->[$k];
        last if ( $j > $jmax - 1 );

if ( $old_rtokens->[$k] eq $rtokens->[$j] ) {
            $in_match                  = 1;
            $new_fields[$j]            = $current_field;
            $new_field_lengths[$j]     = $current_field_length;
            $new_matching_patterns[$j] = $current_pattern;
            $current_field             = '';
            $current_field_length      = 0;
            $current_pattern           = '';
            $new_matching_tokens[$j]   = $old_rtokens->[$k];
            $new_alignments[$j]        = $old_line->get_alignment($k);
            $j++;
        }
        else {

if ( $old_rtokens->[$k] =~ /^\=\d*$/ ) {
                last if ( $case == 2 );    # avoid problems with stuff
                                           # like:   $a=$b=$c=$d;
                $hid_equals = 1;
            }
            last
              if ( $in_match && $case == 1 )
              ;    # disallow gaps in matching field types in case 1
        }
    }

# Modify the current state if we are successful.
    # We must exactly reach the ends of the new list for success, and the old
    # pattern must have more fields. Here is an example where the first and
    # second lines have the same number, and we should not align:
    #  my @a = map chr, 0 .. 255;
    #  my @b = grep /\W/,    @a;
    #  my @c = grep /[^\w]/, @a;

# Otherwise, we would get all of the commas aligned, which doesn't work as
    # well:
    #  my @a = map chr,      0 .. 255;
    #  my @b = grep /\W/,    @a;
    #  my @c = grep /[^\w]/, @a;

if (   ( $j == $jmax )
        && ( $current_field eq '' )
        && ( $case != 1 || $hid_equals )
        && ( $maximum_field_index > $jmax ) )
    {
        my $k = $maximum_field_index;
        $current_field   .= $old_rfields->[$k];
        $current_pattern .= $old_rpatterns->[$k];
        $current_field_length += $old_rfield_lengths->[$k];
        $new_fields[$j]            = $current_field;
        $new_field_lengths[$j]     = $current_field_length;
        $new_matching_patterns[$j] = $current_pattern;

$new_alignments[$j] = $old_line->get_alignment($k);
        $maximum_field_index = $j;

$old_line->set_alignments(@new_alignments);
        $old_line->set_jmax($jmax);
        $old_line->set_rtokens( \@new_matching_tokens );
        $old_line->set_rfields( \@new_fields );
        $old_line->set_rfield_lengths( \@new_field_lengths );
        $old_line->set_rpatterns( \@{$rpatterns} );
    }

# Dumb Down starting match if necessary:
    #
    # Consider the following two lines:
    #
    #  {
    #   $a => 20 > 3 ? 1 : 0,
    #   $xyz => 5,
    #  }

# We would like to get alignment regardless of the order of the two lines.
    # If the lines come in in this order, then we will simplify the patterns of
    # the first line in sub eliminate_new_fields.  If the lines come in reverse
    # order, then we achieve this with eliminate_new_fields.

# This update is currently restricted to leading '=>' matches. Although we
    # could do this for both '=' and '=>', overall the results for '=' come out
    # better without this step because this step can eliminate some other good
    # matches.  For example, with the '=' we get:

#  my @disilva = ( "di Silva", "diSilva", "di Si\x{301}lva", "diSi\x{301}lva" );
#  my @dsf     = map "$_\x{FFFE}Fred", @disilva;
#  my @dsj     = map "$_\x{FFFE}John", @disilva;
#  my @dsJ     = map "$_ John", @disilva;

# without including '=' we get:

#  my @disilva = ( "di Silva", "diSilva", "di Si\x{301}lva", "diSi\x{301}lva" );
#  my @dsf = map "$_\x{FFFE}Fred", @disilva;
#  my @dsj = map "$_\x{FFFE}John", @disilva;
#  my @dsJ = map "$_ John",        @disilva;
    elsif (
        $case == 2

&& @new_matching_tokens == 1
        ##&& $new_matching_tokens[0] =~ /^=/   # see note above
        && $new_matching_tokens[0] =~ /^=>/
        && $maximum_field_index > 2
      )
    {
        my $jmaxm             = $jmax - 1;
        my $kmaxm             = $maximum_field_index - 1;
        my $have_side_comment = $old_rtokens->[$kmaxm] eq '#';

# We need to reduce the group pattern to be just two tokens,
        # the leading equality or => and the final side comment

my $mid_field = join "",
          @{$old_rfields}[ 1 .. $maximum_field_index - 1 ];
        my $mid_patterns = join "",
          @{$old_rpatterns}[ 1 .. $maximum_field_index - 1 ];
        my $mid_field_length = 0;
        foreach ( @{$old_rfield_lengths}[ 1 .. $maximum_field_index - 1 ] ) {
            $mid_field_length += $_;
        }
        my @new_alignments = (
            $old_line->get_alignment(0),
            $old_line->get_alignment( $maximum_field_index - 1 )
        );
        my @new_tokens =
          ( $old_rtokens->[0], $old_rtokens->[ $maximum_field_index - 1 ] );

my @new_fields = (
            $old_rfields->[0], $mid_field, $old_rfields->[$maximum_field_index]
        );

my @new_field_lengths = (
            $old_rfield_lengths->[0],
            $mid_field_length, $old_rfield_lengths->[$maximum_field_index]
        );

my @new_patterns = (
            $old_rpatterns->[0], $mid_patterns,
            $old_rpatterns->[$maximum_field_index]
        );

$maximum_field_index = 2;
        $old_line->set_jmax($maximum_field_index);
        $old_line->set_rtokens( \@new_tokens );
        $old_line->set_rfields( \@new_fields );
        $old_line->set_rfield_lengths( \@new_field_lengths );
        $old_line->set_rpatterns( \@new_patterns );

initialize_for_new_group();
        add_to_group($old_line);
    }
    return;
}

# create an empty side comment if none exists
sub make_side_comment {
    my ( $new_line, $level_end ) = @_;
    my $jmax    = $new_line->get_jmax();
    my $rtokens = $new_line->get_rtokens();

# if line does not have a side comment...
    if ( ( $jmax == 0 ) || ( $rtokens->[ $jmax - 1 ] ne '#' ) ) {
        my $rfields        = $new_line->get_rfields();
        my $rfield_lengths = $new_line->get_rfield_lengths();
        my $rpatterns      = $new_line->get_rpatterns();
        $jmax += 1;
        $rtokens->[ $jmax - 1 ]  = '#';
        $rfields->[$jmax]        = '';
        $rfield_lengths->[$jmax] = 0;
        $rpatterns->[$jmax]      = '#';
        $new_line->set_jmax($jmax);
        $new_line->set_jmax_original_line($jmax);
    }

# line has a side comment..
    else {

# don't remember old side comment location for very long
        my $line_number = $vertical_aligner_self->get_output_line_number();
        my $rfields     = $new_line->get_rfields();
        if (
            $line_number - $last_side_comment_line_number > 12

# and don't remember comment location across block level changes
            || (   $level_end < $last_side_comment_level
                && $rfields->[0] =~ /^}/ )
          )
        {
            forget_side_comment();
        }
        $last_side_comment_line_number = $line_number;
        $last_side_comment_level       = $level_end;
    }
    return;
}

sub decide_if_list {

my $line = shift;

# A list will be taken to be a line with a forced break in which all
    # of the field separators are commas or comma-arrows (except for the
    # trailing #)

# List separator tokens are things like ',3'   or '=>2',
    # where the trailing digit is the nesting depth.  Allow braces
    # to allow nested list items.
    my $rtokens    = $line->get_rtokens();
    my $test_token = $rtokens->[0];
    if ( $test_token =~ /^(\,|=>)/ ) {
        my $list_type = $test_token;
        my $jmax      = $line->get_jmax();

foreach ( 1 .. $jmax - 2 ) {
            if ( $rtokens->[$_] !~ /^(\,|=>)/ ) {
                $list_type = "";
                last;
            }
        }
        $line->set_list_type($list_type);
    }
    return;
}

sub eliminate_new_fields {

my ( $new_line, $old_line ) = @_;
    return unless (@group_lines);
    my $jmax = $new_line->get_jmax();

my $old_rtokens = $old_line->get_rtokens();
    my $rtokens     = $new_line->get_rtokens();
    my $is_assignment =
      ( $rtokens->[0] =~ /^=>?\d*$/ && ( $old_rtokens->[0] eq $rtokens->[0] ) );

# must be monotonic variation
    return unless ( $is_assignment || $previous_maximum_jmax_seen <= $jmax );

# must be more fields in the new line
    my $maximum_field_index = $old_line->get_jmax();
    return unless ( $maximum_field_index < $jmax );

unless ($is_assignment) {
        return
          unless ( $old_line->get_jmax_original_line() == $minimum_jmax_seen )
          ;    # only if monotonic

# never combine fields of a comma list
        return
          unless ( $maximum_field_index > 1 )
          && ( $new_line->get_list_type() !~ /^,/ );
    }

my $rfields        = $new_line->get_rfields();
    my $rfield_lengths = $new_line->get_rfield_lengths();
    my $rpatterns      = $new_line->get_rpatterns();
    my $old_rpatterns  = $old_line->get_rpatterns();

# loop over all OLD tokens except comment and check match
    my $match = 1;
    foreach my $k ( 0 .. $maximum_field_index - 2 ) {
        if (   ( $old_rtokens->[$k] ne $rtokens->[$k] )
            || ( $old_rpatterns->[$k] ne $rpatterns->[$k] ) )
        {
            $match = 0;
            last;
        }
    }

# first tokens agree, so combine extra new tokens
    if ($match) {
        foreach my $k ( $maximum_field_index .. $jmax - 1 ) {

$rfields->[ $maximum_field_index - 1 ] .= $rfields->[$k];
            $rfields->[$k] = "";
            $rfield_lengths->[ $maximum_field_index - 1 ] +=
              $rfield_lengths->[$k];
            $rfield_lengths->[$k] = 0;
            $rpatterns->[ $maximum_field_index - 1 ] .= $rpatterns->[$k];
            $rpatterns->[$k] = "";
        }

$rtokens->[ $maximum_field_index - 1 ]  = '#';
        $rfields->[$maximum_field_index]        = $rfields->[$jmax];
        $rfield_lengths->[$maximum_field_index] = $rfield_lengths->[$jmax];
        $rpatterns->[$maximum_field_index]      = $rpatterns->[$jmax];
        $jmax                                   = $maximum_field_index;
    }
    $new_line->set_jmax($jmax);
    return;
}

sub fix_terminal_ternary {

# Add empty fields as necessary to align a ternary term
    # like this:
    #
    #  my $leapyear =
    #      $year % 4   ? 0
    #    : $year % 100 ? 1
    #    : $year % 400 ? 0
    #    :               1;
    #
    # returns 1 if the terminal item should be indented

my ( $old_line, $rfields, $rtokens, $rpatterns, $rfield_lengths ) = @_;
    return unless ($old_line);

## FUTURE CODING
##     my ( $old_line, $end_line ) = @_;
##     return unless ( $old_line && $end_line );
##
##     my $rfields   = $end_line->get_rfields();
##     my $rpatterns = $end_line->get_rpatterns();
##     my $rtokens   = $end_line->get_rtokens();

my $jmax        = @{$rfields} - 1;
    my $rfields_old = $old_line->get_rfields();

my $rpatterns_old       = $old_line->get_rpatterns();
    my $rtokens_old         = $old_line->get_rtokens();
    my $maximum_field_index = $old_line->get_jmax();

# look for the question mark after the :
    my ($jquestion);
    my $depth_question;
    my $pad        = "";
    my $pad_length = 0;
    foreach my $j ( 0 .. $maximum_field_index - 1 ) {
        my $tok = $rtokens_old->[$j];
        if ( $tok =~ /^\?(\d+)$/ ) {
            $depth_question = $1;

# depth must be correct
            next unless ( $depth_question eq $group_level );

$jquestion = $j;
            if ( $rfields_old->[ $j + 1 ] =~ /^(\?\s*)/ ) {
                $pad_length = length($1);
                $pad        = " " x $pad_length;
            }
            else {
                return;    # shouldn't happen
            }
            last;
        }
    }
    return unless ( defined($jquestion) );    # shouldn't happen

# Now splice the tokens and patterns of the previous line
    # into the else line to insure a match.  Add empty fields
    # as necessary.
    my $jadd = $jquestion;

# Work on copies of the actual arrays in case we have
    # to return due to an error
    my @fields        = @{$rfields};
    my @patterns      = @{$rpatterns};
    my @tokens        = @{$rtokens};
    my @field_lengths = @{$rfield_lengths};

VALIGN_DEBUG_FLAG_TERNARY && do {
        local $" = '><';
        print STDOUT "CURRENT FIELDS=<@{$rfields_old}>\n";
        print STDOUT "CURRENT TOKENS=<@{$rtokens_old}>\n";
        print STDOUT "CURRENT PATTERNS=<@{$rpatterns_old}>\n";
        print STDOUT "UNMODIFIED FIELDS=<@{$rfields}>\n";
        print STDOUT "UNMODIFIED TOKENS=<@{$rtokens}>\n";
        print STDOUT "UNMODIFIED PATTERNS=<@{$rpatterns}>\n";
    };

# handle cases of leading colon on this line
    if ( $fields[0] =~ /^(:\s*)(.*)$/ ) {

my ( $colon, $therest ) = ( $1, $2 );

# Handle sub-case of first field with leading colon plus additional code
        # This is the usual situation as at the '1' below:
        #  ...
        #  : $year % 400 ? 0
        #  :               1;
        if ($therest) {

# Split the first field after the leading colon and insert padding.
            # Note that this padding will remain even if the terminal value goes
            # out on a separate line.  This does not seem to look to bad, so no
            # mechanism has been included to undo it.
            my $field1        = shift @fields;
            my $field_length1 = shift @field_lengths;
            my $len_colon     = length($colon);
            unshift @fields, ( $colon, $pad . $therest );
            unshift @field_lengths,
              ( $len_colon, $pad_length + $field_length1 - $len_colon );

# change the leading pattern from : to ?
            return unless ( $patterns[0] =~ s/^\:/?/ );

# install leading tokens and patterns of existing line
            unshift( @tokens,   @{$rtokens_old}[ 0 .. $jquestion ] );
            unshift( @patterns, @{$rpatterns_old}[ 0 .. $jquestion ] );

# insert appropriate number of empty fields
            splice( @fields,        1, 0, ('') x $jadd ) if $jadd;
            splice( @field_lengths, 1, 0, (0) x $jadd )  if $jadd;
        }

# handle sub-case of first field just equal to leading colon.
        # This can happen for example in the example below where
        # the leading '(' would create a new alignment token
        # : ( $name =~ /[]}]$/ ) ? ( $mname = $name )
        # :                        ( $mname = $name . '->' );
        else {

return unless ( $jmax > 0 && $tokens[0] ne '#' ); # shouldn't happen

# prepend a leading ? onto the second pattern
            $patterns[1] = "?b" . $patterns[1];

# pad the second field
            $fields[1]        = $pad . $fields[1];
            $field_lengths[1] = $pad_length + $field_lengths[1];

# install leading tokens and patterns of existing line, replacing
            # leading token and inserting appropriate number of empty fields
            splice( @tokens,   0, 1, @{$rtokens_old}[ 0 .. $jquestion ] );
            splice( @patterns, 1, 0, @{$rpatterns_old}[ 1 .. $jquestion ] );
            splice( @fields,        1, 0, ('') x $jadd ) if $jadd;
            splice( @field_lengths, 1, 0, (0) x $jadd )  if $jadd;
        }
    }

# Handle case of no leading colon on this line.  This will
    # be the case when -wba=':' is used.  For example,
    #  $year % 400 ? 0 :
    #                1;
    else {

# install leading tokens and patterns of existing line
        $patterns[0] = '?' . 'b' . $patterns[0];
        unshift( @tokens,   @{$rtokens_old}[ 0 .. $jquestion ] );
        unshift( @patterns, @{$rpatterns_old}[ 0 .. $jquestion ] );

# insert appropriate number of empty fields
        $jadd             = $jquestion + 1;
        $fields[0]        = $pad . $fields[0];
        $field_lengths[0] = $pad_length + $field_lengths[0];
        splice( @fields,        0, 0, ('') x $jadd ) if $jadd;
        splice( @field_lengths, 0, 0, (0) x $jadd )  if $jadd;
    }

VALIGN_DEBUG_FLAG_TERNARY && do {
        local $" = '><';
        print STDOUT "MODIFIED TOKENS=<@tokens>\n";
        print STDOUT "MODIFIED PATTERNS=<@patterns>\n";
        print STDOUT "MODIFIED FIELDS=<@fields>\n";
    };

# all ok .. update the arrays
    @{$rfields}        = @fields;
    @{$rtokens}        = @tokens;
    @{$rpatterns}      = @patterns;
    @{$rfield_lengths} = @field_lengths;
## FUTURE CODING
##     $end_line->set_rfields( \@fields );
##     $end_line->set_rtokens( \@tokens );
##     $end_line->set_rpatterns( \@patterns );

# force a flush after this line
    return $jquestion;
}

sub fix_terminal_else {

# Add empty fields as necessary to align a balanced terminal
    # else block to a previous if/elsif/unless block,
    # like this:
    #
    #  if   ( 1 || $x ) { print "ok 13\n"; }
    #  else             { print "not ok 13\n"; }
    #
    # returns a positive value if the else block should be indented
    #
    my ( $old_line, $rfields, $rtokens, $rpatterns, $rfield_lengths ) = @_;
    return unless ($old_line);
    my $jmax = @{$rfields} - 1;
    return unless ( $jmax > 0 );

# check for balanced else block following if/elsif/unless
    my $rfields_old = $old_line->get_rfields();

# TBD: add handling for 'case'
    return unless ( $rfields_old->[0] =~ /^(if|elsif|unless)\s*$/ );

# look for the opening brace after the else, and extract the depth
    my $tok_brace = $rtokens->[0];
    my $depth_brace;
    if ( $tok_brace =~ /^\{(\d+)/ ) { $depth_brace = $1; }

# probably:  "else # side_comment"
    else { return }

my $rpatterns_old       = $old_line->get_rpatterns();
    my $rtokens_old         = $old_line->get_rtokens();
    my $maximum_field_index = $old_line->get_jmax();

# be sure the previous if/elsif is followed by an opening paren
    my $jparen    = 0;
    my $tok_paren = '(' . $depth_brace;
    my $tok_test  = $rtokens_old->[$jparen];
    return unless ( $tok_test eq $tok_paren );    # shouldn't happen

# Now find the opening block brace
    my ($jbrace);
    foreach my $j ( 1 .. $maximum_field_index - 1 ) {
        my $tok = $rtokens_old->[$j];
        if ( $tok eq $tok_brace ) {
            $jbrace = $j;
            last;
        }
    }
    return unless ( defined($jbrace) );           # shouldn't happen

# Now splice the tokens and patterns of the previous line
    # into the else line to insure a match.  Add empty fields
    # as necessary.
    my $jadd = $jbrace - $jparen;
    splice( @{$rtokens},   0, 0, @{$rtokens_old}[ $jparen .. $jbrace - 1 ] );
    splice( @{$rpatterns}, 1, 0, @{$rpatterns_old}[ $jparen + 1 .. $jbrace ] );
    splice( @{$rfields},        1, 0, ('') x $jadd );
    splice( @{$rfield_lengths}, 1, 0, (0) x $jadd );

# force a flush after this line if it does not follow a case
    if   ( $rfields_old->[0] =~ /^case\s*$/ ) { return }
    else                                      { return $jbrace }
}

{    # sub check_match
    my %is_good_alignment;

BEGIN {

# Vertically aligning on certain "good" tokens is usually okay
        # so we can be less restrictive in marginal cases.
        my @q = qw( { ? => = );
        push @q, (',');
        @is_good_alignment{@q} = (1) x scalar(@q);
    }

sub check_match {

# See if the current line matches the current vertical alignment group.
        # If not, flush the current group.
        my ( $new_line, $old_line ) = @_;

# uses global variables:
        #  $previous_minimum_jmax_seen
        #  $maximum_jmax_seen
        #  $marginal_match
        my $jmax                = $new_line->get_jmax();
        my $maximum_field_index = $old_line->get_jmax();

# flush if this line has too many fields
        # variable $GoToLoc indicates goto branch point, for debugging
        my $GoToLoc = 1;
        if ( $jmax > $maximum_field_index ) { goto NO_MATCH }

# flush if adding this line would make a non-monotonic field count
        if (
            ( $maximum_field_index > $jmax )    # this has too few fields
            && (
                ( $previous_minimum_jmax_seen <
                    $jmax )                     # and wouldn't be monotonic
                || ( $old_line->get_jmax_original_line() != $maximum_jmax_seen )
            )
          )
        {
            $GoToLoc = 2;
            goto NO_MATCH;
        }

# otherwise see if this line matches the current group
        my $jmax_original_line      = $new_line->get_jmax_original_line();
        my $is_hanging_side_comment = $new_line->get_is_hanging_side_comment();
        my $rtokens                 = $new_line->get_rtokens();
        my $rfields                 = $new_line->get_rfields();
        my $rfield_lengths          = $new_line->get_rfield_lengths();
        my $rpatterns               = $new_line->get_rpatterns();
        my $list_type               = $new_line->get_list_type();

my $group_list_type = $old_line->get_list_type();
        my $old_rpatterns   = $old_line->get_rpatterns();
        my $old_rtokens     = $old_line->get_rtokens();

my $jlimit = $jmax - 1;

# handle comma-separated lists ..
        if ( $group_list_type && ( $list_type eq $group_list_type ) ) {
            for my $j ( 0 .. $jlimit ) {
                my $old_tok = $old_rtokens->[$j];
                next unless $old_tok;
                my $new_tok = $rtokens->[$j];
                next unless $new_tok;

# lists always match ...
                # unless they would align any '=>'s with ','s
                $GoToLoc = 3;
                goto NO_MATCH
                  if ( $old_tok =~ /^=>/ && $new_tok =~ /^,/
                    || $new_tok =~ /^=>/ && $old_tok =~ /^,/ );
            }
        }

# do detailed check for everything else except hanging side comments
        elsif ( !$is_hanging_side_comment ) {

my $leading_space_count = $new_line->get_leading_space_count();

my $max_pad = 0;
            my $min_pad = 0;
            my $saw_good_alignment;

for my $j ( 0 .. $jlimit ) {

my $old_tok = $old_rtokens->[$j];
                my $new_tok = $rtokens->[$j];

# Note on encoding used for alignment tokens:
                # -------------------------------------------
                # Tokens are "decorated" with information which can help
                # prevent unwanted alignments.  Consider for example the
                # following two lines:
                #   local ( $xn, $xd ) = split( '/', &'rnorm(@_) );
                #   local ( $i, $f ) = &'bdiv( $xn, $xd );
                # There are three alignment tokens in each line, a comma,
                # an =, and a comma.  In the first line these three tokens
                # are encoded as:
                #    ,4+local-18     =3      ,4+split-7
                # and in the second line they are encoded as
                #    ,4+local-18     =3      ,4+&'bdiv-8
                # Tokens always at least have token name and nesting
                # depth.  So in this example the ='s are at depth 3 and
                # the ,'s are at depth 4.  This prevents aligning tokens
                # of different depths.  Commas contain additional
                # information, as follows:
                # ,  {depth} + {container name} - {spaces to opening paren}
                # This allows us to reject matching the rightmost commas
                # in the above two lines, since they are for different
                # function calls.  This encoding is done in
                # 'sub send_lines_to_vertical_aligner'.

# Pick off actual token.
                # Everything up to the first digit is the actual token.
                my $alignment_token = $new_tok;
                if ( $alignment_token =~ /^([^\d]+)/ ) { $alignment_token = $1 }

# see if the decorated tokens match
                my $tokens_match = $new_tok eq $old_tok

# Exception for matching terminal : of ternary statement..
                  # consider containers prefixed by ? and : a match
                  || ( $new_tok =~ /^,\d*\+\:/ && $old_tok =~ /^,\d*\+\?/ );

# No match if the alignment tokens differ...
                if ( !$tokens_match ) {

# ...Unless this is a side comment
                    if (
                        $j == $jlimit

# and there is either at least one alignment token
                        # or this is a single item following a list.  This
                        # latter rule is required for 'December' to join
                        # the following list:
                        # my (@months) = (
                        #     '',       'January',   'February', 'March',
                        #     'April',  'May',       'June',     'July',
                        #     'August', 'September', 'October',  'November',
                        #     'December'
                        # );
                        # If it doesn't then the -lp formatting will fail.
                        && ( $j > 0 || $old_tok =~ /^,/ )
                      )
                    {
                        $marginal_match = 1
                          if ( $marginal_match == 0
                            && @group_lines == 1 );
                        last;
                    }

$GoToLoc = 4;
                    goto NO_MATCH;
                }

# Calculate amount of padding required to fit this in.
                # $pad is the number of spaces by which we must increase
                # the current field to squeeze in this field.
                my $pad =
                  $rfield_lengths->[$j] - $old_line->current_field_width($j);
                if ( $j == 0 ) { $pad += $leading_space_count; }

# remember max pads to limit marginal cases
                if ( $alignment_token ne '#' ) {
                    if ( $pad > $max_pad ) { $max_pad = $pad }
                    if ( $pad < $min_pad ) { $min_pad = $pad }
                }
                if ( $is_good_alignment{$alignment_token} ) {
                    $saw_good_alignment = 1;
                }

# If patterns don't match, we have to be careful...
                if ( $old_rpatterns->[$j] ne $rpatterns->[$j] ) {

# flag this as a marginal match since patterns differ
                    $marginal_match = 1
                      if ( $marginal_match == 0 && @group_lines == 1 );

# We have to be very careful about aligning commas
                    # when the pattern's don't match, because it can be
                    # worse to create an alignment where none is needed
                    # than to omit one.  Here's an example where the ','s
                    # are not in named containers.  The first line below
                    # should not match the next two:
                    #   ( $a, $b ) = ( $b, $r );
                    #   ( $x1, $x2 ) = ( $x2 - $q * $x1, $x1 );
                    #   ( $y1, $y2 ) = ( $y2 - $q * $y1, $y1 );
                    if ( $alignment_token eq ',' ) {

# do not align commas unless they are in named containers
                        $GoToLoc = 5;
                        goto NO_MATCH unless ( $new_tok =~ /[A-Za-z]/ );
                    }

# do not align parens unless patterns match;
                    # large ugly spaces can occur in math expressions.
                    elsif ( $alignment_token eq '(' ) {

# But we can allow a match if the parens don't
                        # require any padding.
                        $GoToLoc = 6;
                        if ( $pad != 0 ) { goto NO_MATCH }
                    }

# Handle an '=' alignment with different patterns to
                    # the left.
                    elsif ( $alignment_token eq '=' ) {

# It is best to be a little restrictive when
                        # aligning '=' tokens.  Here is an example of
                        # two lines that we will not align:
                        #       my $variable=6;
                        #       $bb=4;
                        # The problem is that one is a 'my' declaration,
                        # and the other isn't, so they're not very similar.
                        # We will filter these out by comparing the first
                        # letter of the pattern.  This is crude, but works
                        # well enough.
                        if (
                            substr( $old_rpatterns->[$j], 0, 1 ) ne
                            substr( $rpatterns->[$j],     0, 1 ) )
                        {
                            $GoToLoc = 7;
                            goto NO_MATCH;
                        }

# If we pass that test, we'll call it a marginal match.
                        # Here is an example of a marginal match:
                        #       $done{$$op} = 1;
                        #       $op         = compile_bblock($op);
                        # The left tokens are both identifiers, but
                        # one accesses a hash and the other doesn't.
                        # We'll let this be a tentative match and undo
                        # it later if we don't find more than 2 lines
                        # in the group.
                        elsif ( @group_lines == 1 ) {
                            $marginal_match =
                              2;    # =2 prevents being undone below
                        }
                    }
                }

# Don't let line with fewer fields increase column widths
                # ( align3.t )
                if ( $maximum_field_index > $jmax ) {

# Exception: suspend this rule to allow last lines to join
                    $GoToLoc = 8;
                    if ( $pad > 0 ) { goto NO_MATCH; }
                }
            } ## end for my $j ( 0 .. $jlimit)

# Turn off the "marginal match" flag in some cases...
            # A "marginal match" occurs when the alignment tokens agree
            # but there are differences in the other tokens (patterns).
            # If we leave the marginal match flag set, then the rule is that we
            # will align only if there are more than two lines in the group.
            # We will turn of the flag if we almost have a match
            # and either we have seen a good alignment token or we
            # just need a small pad (2 spaces) to fit.  These rules are
            # the result of experimentation.  Tokens which misaligned by just
            # one or two characters are annoying.  On the other hand,
            # large gaps to less important alignment tokens are also annoying.
            if (   $marginal_match == 1
                && $jmax == $maximum_field_index
                && ( $saw_good_alignment || ( $max_pad < 3 && $min_pad > -3 ) )
              )
            {
                $marginal_match = 0;
            }
            ##print "marginal=$marginal_match saw=$saw_good_alignment jmax=$jmax max=$maximum_field_index maxpad=$max_pad minpad=$min_pad\n";
        }

# We have a match (even if marginal).
        # If the current line has fewer fields than the current group
        # but otherwise matches, copy the remaining group fields to
        # make it a perfect match.
        if ( $maximum_field_index > $jmax ) {

##########################################################
            # FIXME: The previous version had a bug which made side comments
            # become regular fields, so for now the program does not allow a
            # line with side comment to match.  This should eventually be done.
            # The best test file for experimenting is 'lista.t'
            ##########################################################

my $comment = $rfields->[$jmax];
            $GoToLoc = 9;
            goto NO_MATCH if ($comment);

# Corrected loop; a test case is file 'fig13_20.pl'
            for my $jj ( $jmax .. $maximum_field_index ) {
                $rtokens->[ $jj - 1 ]  = $old_rtokens->[ $jj - 1 ];
                $rpatterns->[$jj]      = $old_rpatterns->[$jj];
                $rfields->[$jj]        = '';
                $rfield_lengths->[$jj] = 0;
            }

##          THESE DO NOT GIVE CORRECT RESULTS
##          $rfields->[$jmax] = $comment;
##          $new_line->set_jmax($jmax);

}

return;

NO_MATCH:

# variable $GoToLoc is for debugging
        #print "no match from $GoToLoc\n";

# Make one last effort to retain a match of certain statements
        my $match = salvage_equality_matches( $new_line, $old_line );
        my_flush_code() unless ($match);
        return;
    }
}

sub salvage_equality_matches {
    my ( $new_line, $old_line ) = @_;

# Reduce the complexity of the two lines if it will allow us to retain
    # alignment of some common alignments, including '=' and '=>'.  We will
    # convert both lines to have just two matching tokens, the equality and the
    # side comment.

# return 0 or undef if unsuccessful
    # return 1 if successful

# Here is a very simple example of two lines where we could at least
    # align the equals:
    #  $x = $class->_sub( $x, $delta );
    #  $xpownm1 = $class->_pow( $class->_copy($x), $nm1 );    # x(i)^(n-1)

# We will only do this if there is one old line (and one new line)
    return unless ( @group_lines == 1 );
    return if ($is_matching_terminal_line);

# We are only looking for equality type statements
    my $old_rtokens = $old_line->get_rtokens();
    my $rtokens     = $new_line->get_rtokens();
    my $is_equals =
      ( $rtokens->[0] =~ /=/ && ( $old_rtokens->[0] eq $rtokens->[0] ) );
    return unless ($is_equals);

# The leading patterns must match
    my $old_rpatterns = $old_line->get_rpatterns();
    my $rpatterns     = $new_line->get_rpatterns();
    return if ( $old_rpatterns->[0] ne $rpatterns->[0] );

# Both should have side comment fields (should always be true)
    my $jmax_old    = $old_line->get_jmax();
    my $jmax_new    = $new_line->get_jmax();
    my $end_tok_old = $old_rtokens->[ $jmax_old - 1 ];
    my $end_tok_new = $rtokens->[ $jmax_new - 1 ];
    my $have_side_comments =
         defined($end_tok_old)
      && $end_tok_old eq '#'
      && defined($end_tok_new)
      && $end_tok_new eq '#';
    if ( !$have_side_comments ) { return; }

# Do not match if any remaining tokens in new line include '?', 'if',
    # 'unless','||', '&&'. The reason is that (1) this isn't a great match, and
    # (2) we will prevent possibly better matchs to follow.  Here is an
    # example.  The match of the first two lines is rejected, and this allows
    # the second and third lines to match.
    #   my $type = shift || "o";
    #   my $fname  = ( $type eq 'oo'               ? 'orte_city' : 'orte' );
    #   my $suffix = ( $coord_system eq 'standard' ? ''          : '-orig' );
    # This logic can cause some unwanted losses of alignments, but it can retain
    # long runs of multiple-token alignments, so overall it is worthwhile.
    # If we had a peek at the subsequent line we could make a much better
    # decision here, but for now this is not available.
    for ( my $j = 1 ; $j < $jmax_new - 1 ; $j++ ) {
        my $new_tok = $rtokens->[$j];

# git#16: do not consider fat commas as good aligmnents here
        my $is_good_alignment =
          ( $new_tok =~ /^(=|\?|if|unless|\|\||\&\&)/ && $new_tok !~ /^=>/ );
        return if ($is_good_alignment);
    }

my $squeeze_line = sub {
        my ($line_obj) = @_;

# reduce a line down to the three fields surrounding
        # the two tokens, an '=' of some sort and a '#' at the end

my $jmax     = $line_obj->get_jmax();
        my $jmax_new = 2;
        return unless $jmax > $jmax_new;
        my $rfields        = $line_obj->get_rfields();
        my $rfield_lengths = $line_obj->get_rfield_lengths();
        my $rpatterns      = $line_obj->get_rpatterns();
        my $rtokens        = $line_obj->get_rtokens();
        my $rfields_new    = [
            $rfields->[0], join( '', @{$rfields}[ 1 .. $jmax - 1 ] ),
            $rfields->[$jmax]
        ];

my $mid_length = 0;
        foreach ( @{$rfield_lengths}[ 1 .. $jmax - 1 ] ) { $mid_length += $_ }
        my $rfield_lengths_new =
          [ $rfield_lengths->[0], $mid_length, $rfield_lengths->[$jmax] ];

my $rpatterns_new = [
            $rpatterns->[0], join( '', @{$rpatterns}[ 1 .. $jmax - 1 ] ),
            $rpatterns->[$jmax]
        ];
        my $rtokens_new = [ $rtokens->[0], $rtokens->[ $jmax - 1 ] ];
        $line_obj->{_rfields}        = $rfields_new;
        $line_obj->{_rfield_lengths} = $rfield_lengths_new;
        $line_obj->{_rpatterns}      = $rpatterns_new;
        $line_obj->{_rtokens}        = $rtokens_new;
        $line_obj->set_jmax($jmax_new);
    };

# Okay, we will force a match at the equals-like token.  We will fix both
    # lines to have just 2 tokens and 3 fields:
    $squeeze_line->($new_line);
    $squeeze_line->($old_line);

# start over with a new group
    initialize_for_new_group();
    add_to_group($old_line);
    return 1;
}

sub check_fit {

my ( $new_line, $old_line ) = @_;
    return unless (@group_lines);

my $jmax                    = $new_line->get_jmax();
    my $leading_space_count     = $new_line->get_leading_space_count();
    my $is_hanging_side_comment = $new_line->get_is_hanging_side_comment();
    my $rtokens                 = $new_line->get_rtokens();
    my $rfields                 = $new_line->get_rfields();
    my $rfield_lengths          = $new_line->get_rfield_lengths();
    my $rpatterns               = $new_line->get_rpatterns();

my $group_list_type = $group_lines[0]->get_list_type();

my $padding_so_far    = 0;
    my $padding_available = $old_line->get_available_space_on_right();

# save current columns in case this doesn't work
    save_alignment_columns();

my $maximum_field_index = $old_line->get_jmax();
    for my $j ( 0 .. $jmax ) {

##my $pad = length( $rfields->[$j] ) - $old_line->current_field_width($j);
        my $pad = $rfield_lengths->[$j] - $old_line->current_field_width($j);

if ( $j == 0 ) {
            $pad += $leading_space_count;
        }

# remember largest gap of the group, excluding gap to side comment
        if (   $pad < 0
            && $group_maximum_gap < -$pad
            && $j > 0
            && $j < $jmax - 1 )
        {
            $group_maximum_gap = -$pad;
        }

next if $pad < 0;

## OLD NOTES:
        ## This patch helps sometimes, but it doesn't check to see if
        ## the line is too long even without the side comment.  It needs
        ## to be reworked.
        ##don't let a long token with no trailing side comment push
        ##side comments out, or end a group.  (sidecmt1.t)
        ##next if ($j==$jmax-1 && length($rfields->[$jmax])==0);

# BEGIN PATCH for keith1.txt.
        # If the group began matching multiple tokens but later this got
        # reduced to a fewer number of matching tokens, then the fields
        # of the later lines will still have to fit into their corresponding
        # fields.  So a large later field will "push" the other fields to
        # the right, including previous side comments, and if there is no room
        # then there is no match.
        # For example, look at the last line in the following snippet:

# my $b_prod_db = ( $ENV{ORACLE_SID} =~ m/p$/ && !$testing ) ? true    : false;
 # my $env       = ($b_prod_db)                               ? "prd"   : "val";
 # my $plant     = ( $OPT{p} )                                ? $OPT{p} : "STL";
 # my $task      = $OPT{t};
 # my $fnam      = "longggggggggggggggg.$record_created.$env.$plant.idash";

# The long term will push the '?' to the right to fit in, and in this
        # case there is not enough room so it will not match the equals unless
        # we do something special.

# Usually it looks good to keep an initial alignment of '=' going, and
        # we can do this if the long term can fit in the space taken up by the
        # remaining fields (the ? : fields here).

# Allowing any matching token for now, but it could be restricted
        # to an '='-like token if necessary.

if (
               $pad > $padding_available
            && $jmax == 2                       # matching one thing (plus #)
            && $j == $jmax - 1                  # at last field
            && @group_lines > 1                 # more than 1 line in group now
            && $jmax < $maximum_field_index     # other lines have more fields
            && $rfield_lengths->[$jmax] == 0    # no side comment

# Uncomment to match only equals (but this does not seem necessary)
            # && $rtokens->[0] =~ /^=\d/           # matching an equals
          )
        {
            my $extra_padding = 0;
            foreach my $jj ( $j + 1 .. $maximum_field_index - 1 ) {
                $extra_padding += $old_line->current_field_width($jj);
            }

next if ( $pad <= $padding_available + $extra_padding );
        }

# END PATCH for keith1.pl

# This line will need space; lets see if we want to accept it..
        if (

# not if this won't fit
            ( $pad > $padding_available )

# previously, there were upper bounds placed on padding here
            # (maximum_whitespace_columns), but they were not really helpful

)
        {

# revert to starting state then flush; things didn't work out
            restore_alignment_columns();
            my_flush_code();
            last;
        }

# patch to avoid excessive gaps in previous lines,
        # due to a line of fewer fields.
        #   return join( ".",
        #       $self->{"dfi"},  $self->{"aa"}, $self->rsvd,     $self->{"rd"},
        #       $self->{"area"}, $self->{"id"}, $self->{"sel"} );
        next if ( $jmax < $maximum_field_index && $j == $jmax - 1 );

# looks ok, squeeze this field in
        $old_line->increase_field_width( $j, $pad );
        $padding_available -= $pad;

# remember largest gap of the group, excluding gap to side comment
        if ( $pad > $group_maximum_gap && $j > 0 && $j < $jmax - 1 ) {
            $group_maximum_gap = $pad;
        }
    }
    return;
}

sub add_to_group {

# The current line either starts a new alignment group or is
    # accepted into the current alignment group.
    my ($new_line) = @_;
    push_group_line($new_line);

# initialize field lengths if starting new group
    if ( @group_lines == 1 ) {

my $jmax           = $new_line->get_jmax();
        my $rfields        = $new_line->get_rfields();
        my $rfield_lengths = $new_line->get_rfield_lengths();
        my $rtokens        = $new_line->get_rtokens();
        my $col            = $new_line->get_leading_space_count();

for my $j ( 0 .. $jmax ) {
            $col += $rfield_lengths->[$j];

# create initial alignments for the new group
            my $token = "";
            if ( $j < $jmax ) { $token = $rtokens->[$j] }
            my $alignment = make_alignment( $col, $token );
            $new_line->set_alignment( $j, $alignment );
        }

$maximum_jmax_seen = $jmax;
        $minimum_jmax_seen = $jmax;
    }

# use previous alignments otherwise
    else {
        my @new_alignments = $group_lines[-2]->get_alignments();
        $new_line->set_alignments(@new_alignments);
    }

# remember group jmax extremes for next call to valign_input
    $previous_minimum_jmax_seen = $minimum_jmax_seen;
    $previous_maximum_jmax_seen = $maximum_jmax_seen;
    return;
}

sub dump_array {

# debug routine to dump array contents
    local $" = ')(';
    print STDOUT "(@_)\n";
    return;
}

# flush() sends the current Perl::Tidy::VerticalAligner group down the
# pipeline to Perl::Tidy::FileWriter.

# This is the external flush, which also empties the buffer and cache
sub flush {

# the buffer must be emptied first, then any cached text
    dump_valign_buffer();

if (@group_lines) {
        my_flush();
    }
    else {
        if ($cached_line_type) {
            $seqno_string = $cached_seqno_string;
            valign_output_step_C( $cached_line_text,
                $cached_line_leading_space_count,
                $last_level_written );
            $cached_line_type        = 0;
            $cached_line_text        = "";
            $cached_line_text_length = 0;
            $cached_seqno_string     = "";
        }
    }
    return;
}

sub reduce_valign_buffer_indentation {

my ($diff) = @_;
    if ( $valign_buffer_filling && $diff ) {
        my $max_valign_buffer = @valign_buffer;
        foreach my $i ( 0 .. $max_valign_buffer - 1 ) {
            my ( $line, $leading_space_count, $level ) =
              @{ $valign_buffer[$i] };
            my $ws = substr( $line, 0, $diff );
            if ( ( length($ws) == $diff ) && $ws =~ /^\s+$/ ) {
                $line = substr( $line, $diff );
            }
            if ( $leading_space_count >= $diff ) {
                $leading_space_count -= $diff;
                $level = level_change( $leading_space_count, $diff, $level );
            }
            $valign_buffer[$i] = [ $line, $leading_space_count, $level ];
        }
    }
    return;
}

sub level_change {

# compute decrease in level when we remove $diff spaces from the
    # leading spaces
    my ( $leading_space_count, $diff, $level ) = @_;
    if ($rOpts_indent_columns) {
        my $olev =
          int( ( $leading_space_count + $diff ) / $rOpts_indent_columns );
        my $nlev = int( $leading_space_count / $rOpts_indent_columns );
        $level -= ( $olev - $nlev );
        if ( $level < 0 ) { $level = 0 }
    }
    return $level;
}

sub dump_valign_buffer {
    if (@valign_buffer) {
        foreach (@valign_buffer) {
            valign_output_step_D( @{$_} );
        }
        @valign_buffer = ();
    }
    $valign_buffer_filling = "";
    return;
}

sub my_flush_comment {

# Output a group of COMMENT lines

return unless (@group_lines);
    my $leading_space_count = $comment_leading_space_count;
    my $leading_string      = get_leading_string($leading_space_count);

# look for excessively long lines
    my $max_excess = 0;
    foreach my $item (@group_lines) {
        my ( $str, $str_len ) = @{$item};
        my $excess =
          $str_len +
          $leading_space_count -
          maximum_line_length_for_level($group_level);
        if ( $excess > $max_excess ) {
            $max_excess = $excess;
        }
    }

# zero leading space count if any lines are too long
    if ( $max_excess > 0 ) {
        $leading_space_count -= $max_excess;
        if ( $leading_space_count < 0 ) { $leading_space_count = 0 }
        $last_outdented_line_at = $file_writer_object->get_output_line_number();
        unless ($outdented_line_count) {
            $first_outdented_line_at = $last_outdented_line_at;
        }
        my $nlines = @group_lines;
        $outdented_line_count += $nlines;
    }

# write the lines
    my $outdent_long_lines = 0;

foreach my $item (@group_lines) {
        my ( $line, $line_len ) = @{$item};
        valign_output_step_B(
            leading_space_count       => $leading_space_count,
            line                      => $line,
            line_length               => $line_len,
            side_comment_length       => 0,
            outdent_long_lines        => $outdent_long_lines,
            rvertical_tightness_flags => "",
            level                     => $group_level,
        );
    }

initialize_for_new_group();
    return;
}

sub my_flush_code {

# Output a group of CODE lines

return unless (@group_lines);

VALIGN_DEBUG_FLAG_APPEND0
      && do {
        my $group_list_type = $group_lines[0]->get_list_type();
        my ( $a, $b, $c ) = caller();
        my $nlines              = @group_lines;
        my $maximum_field_index = $group_lines[0]->get_jmax();
        my $rfields_old         = $group_lines[0]->get_rfields();
        my $tok                 = $rfields_old->[0];
        print STDOUT
"APPEND0: my_flush_code called from $a $b $c fields=$maximum_field_index list=$group_list_type lines=$nlines extra=$extra_indent_ok first tok=$tok;\n";

};

# some small groups are best left unaligned
    my $do_not_align = decide_if_aligned_pair();

# optimize side comment location
    $do_not_align = adjust_side_comment($do_not_align);

# recover spaces for -lp option if possible
    my $extra_leading_spaces = get_extra_leading_spaces();

# all lines of this group have the same basic leading spacing
    my $group_leader_length = $group_lines[0]->get_leading_space_count();

# add extra leading spaces if helpful
    # NOTE: Use zero; this did not work well
    my $min_ci_gap = 0;

# output the lines
    foreach my $line (@group_lines) {
        valign_output_step_A(
            line                 => $line,
            min_ci_gap           => $min_ci_gap,
            do_not_align         => $do_not_align,
            group_leader_length  => $group_leader_length,
            extra_leading_spaces => $extra_leading_spaces
        );
    }

initialize_for_new_group();
    return;
}

sub my_flush {

# This is the vertical aligner internal flush, which leaves the cache
    # intact
    return unless (@group_lines);

VALIGN_DEBUG_FLAG_APPEND0 && do {
        my ( $a, $b, $c ) = caller();
        my $nlines = @group_lines;
        print STDOUT
"APPEND0: my_flush called from $a $b $c lines=$nlines, type=$group_type \n";
    };

# handle a group of COMMENT lines
    if ( $group_type eq 'COMMENT' ) { my_flush_comment() }

# handle a single line of CODE
    elsif ( @group_lines == 1 ) { my_flush_code() }

# handle group(s) of CODE lines
    else {

# LP FIX PART 1
        # If we are trying to add extra indentation for -lp formatting,
        # then we need to try to keep the group intact.  But we have
        # to set the $extra_indent_ok flag to zero in case some lines
        # are output separately.  We fix things up at the bottom.
        # NOTE: this is a workaround but is tentative; we should really look to
        # see if if extra indentation is possible.
        my $rOpt_lp              = $rOpts->{'line-up-parentheses'};
        my $keep_group_intact    = $rOpt_lp && $extra_indent_ok;
        my $extra_indent_ok_save = $extra_indent_ok;
        $extra_indent_ok = 0;

# we will rebuild alignment line group(s);
        my @new_lines = @group_lines;
        initialize_for_new_group();

# remove unmatched tokens in all lines
        delete_unmatched_tokens( \@new_lines );

foreach my $new_line (@new_lines) {

# Start a new group if necessary
            if ( !@group_lines ) {
                add_to_group($new_line);
                if ( $new_line->{_end_group} ) {
                    my_flush_code();
                }
                next;
            }

my $j_terminal_match = $new_line->get_j_terminal_match();
            my $base_line        = $group_lines[0];

# Initialize a global flag saying if the last line of the group
            # should match end of group and also terminate the group.  There
            # should be no returns between here and where the flag is handled
            # at the bottom.
            my $col_matching_terminal = 0;
            if ( defined($j_terminal_match) ) {

# remember the column of the terminal ? or { to match with
                $col_matching_terminal =
                  $base_line->get_column($j_terminal_match);

# set global flag for sub decide_if_aligned_pair
                $is_matching_terminal_line = 1;
            }

# -------------------------------------------------------------
            # Allow hanging side comment to join current group, if any. This
            # will help keep side comments aligned, because otherwise we
            # will have to start a new group, making alignment less likely.
            # -------------------------------------------------------------

if ( $new_line->get_is_hanging_side_comment() ) {
                join_hanging_comment( $new_line, $base_line );
            }

# If this line has no matching tokens, then flush out the lines
            # BEFORE this line unless both it and the previous line have side
            # comments.  This prevents this line from pushing side coments out
            # to the right.
            elsif ( $new_line->get_jmax() == 1 && !$keep_group_intact ) {

# There are no matching tokens, so now check side comments.
                # Programming note: accessing arrays with index -1 is
                # risky in Perl, but we have verified there is at least one
                # line in the group and that there is at least one field.
                my $prev_comment = $group_lines[-1]->get_rfields()->[-1];
                my $side_comment = $new_line->get_rfields()->[-1];
                my_flush_code() unless ( $side_comment && $prev_comment );

}

# -------------------------------------------------------------
            # If there is just one previous line, and it has more fields
            # than the new line, try to join fields together to get a match
            # with the new line.  At the present time, only a single
            # leading '=' is allowed to be compressed out.  This is useful
            # in rare cases where a table is forced to use old breakpoints
            # because of side comments,
            # and the table starts out something like this:
            #   my %MonthChars = ('0', 'Jan',   # side comment
            #                     '1', 'Feb',
            #                     '2', 'Mar',
            # Eliminating the '=' field will allow the remaining fields to
            # line up.  This situation does not occur if there are no side
            # comments because scan_list would put a break after the
            # opening '('.
            # -------------------------------------------------------------

eliminate_old_fields( $new_line, $base_line );

# -------------------------------------------------------------
            # If the new line has more fields than the current group,
            # see if we can match the first fields and combine the remaining
            # fields of the new line.
            # -------------------------------------------------------------

eliminate_new_fields( $new_line, $base_line );

# -------------------------------------------------------------
            # Flush previous group unless all common tokens and patterns
            # match..

check_match( $new_line, $base_line );

# -------------------------------------------------------------
            # See if there is space for this line in the current group (if
            # any)
            # -------------------------------------------------------------
            if (@group_lines) {
                check_fit( $new_line, $base_line );
            }

add_to_group($new_line);

if ( defined($j_terminal_match) ) {

# if there is only one line in the group (maybe due to failure
                # to match perfectly with previous lines), then align the ? or
                # { of this terminal line with the previous one unless that
                # would make the line too long
                if ( @group_lines == 1 ) {
                    $base_line = $group_lines[0];
                    my $col_now = $base_line->get_column($j_terminal_match);
                    my $pad     = $col_matching_terminal - $col_now;
                    my $padding_available =
                      $base_line->get_available_space_on_right();
                    if ( $pad > 0 && $pad <= $padding_available ) {
                        $base_line->increase_field_width( $j_terminal_match,
                            $pad );
                    }
                }
                my_flush_code();
                $is_matching_terminal_line = 0;
            }

# end the group if we know we cannot match next line.
            elsif ( $new_line->{_end_group} ) {
                my_flush_code();
            }
        }

# LP FIX PART 2
        # if we managed to keep the group intact for -lp formatting,
        # restore the flag which allows extra indentation
        if ( $keep_group_intact && @group_lines == @new_lines ) {
            $extra_indent_ok = $extra_indent_ok_save;
        }
        my_flush_code();
    }
    return;
}

sub delete_selected_tokens {

my ( $line_obj, $ridel, $new_list_ok ) = @_;

# $line_obj    is the line to be modified
    # $ridel       is a ref to list of indexes to be deleted
    # $new_list_ok is flag giving permission to convert non-list to list

# remove an unused alignment token(s) to improve alignment chances

return unless ( defined($line_obj) && defined($ridel) && @{$ridel} );

my $jmax_old           = $line_obj->get_jmax();
    my $rfields_old        = $line_obj->get_rfields();
    my $rfield_lengths_old = $line_obj->get_rfield_lengths();
    my $rpatterns_old      = $line_obj->get_rpatterns();
    my $rtokens_old        = $line_obj->get_rtokens();

my $EXPLAIN = 0;

local $" = '> <';
    $EXPLAIN && print <<EOM;
delete indexes: <@{$ridel}>
old jmax: $jmax_old
old tokens: <@{$rtokens_old}>
old patterns: <@{$rpatterns_old}>
old fields: <@{$rfields_old}>
old field_lengths: <@{$rfield_lengths_old}>
EOM

my $rfields_new        = [];
    my $rpatterns_new      = [];
    my $rtokens_new        = [];
    my $rfield_lengths_new = [];

my $kmax      = @{$ridel} - 1;
    my $k         = 0;
    my $jdel_next = $ridel->[$k];

if ( $jdel_next < 0 ) { return }    # shouldnt happen
    my $pattern      = $rpatterns_old->[0];
    my $field        = $rfields_old->[0];
    my $field_length = $rfield_lengths_old->[0];
    push @{$rfields_new},        $field;
    push @{$rfield_lengths_new}, $field_length;
    push @{$rpatterns_new},      $pattern;

for ( my $j = 0 ; $j < $jmax_old ; $j++ ) {
        my $token        = $rtokens_old->[$j];
        my $field        = $rfields_old->[ $j + 1 ];
        my $field_length = $rfield_lengths_old->[ $j + 1 ];
        my $pattern      = $rpatterns_old->[ $j + 1 ];
        if ( $k > $kmax || $j < $jdel_next ) {
            push @{$rtokens_new},        $token;
            push @{$rfields_new},        $field;
            push @{$rpatterns_new},      $pattern;
            push @{$rfield_lengths_new}, $field_length;
        }
        elsif ( $j == $jdel_next ) {
            $rfields_new->[-1] .= $field;
            $rfield_lengths_new->[-1] += $field_length;
            $rpatterns_new->[-1] .= $pattern;
            if ( ++$k <= $kmax ) {
                my $jdel_last = $jdel_next;
                $jdel_next = $ridel->[$k];
                if ( $jdel_next < $jdel_last ) {

# FIXME:
                    print STDERR "bad jdel_next=$jdel_next\n";
                    return;
                }
            }
        }
    }

# ----- x ------ x ------ x ------
    #t      0        1        2        <- token indexing
    #f   0      1        2        3    <- field and pattern

my $jmax_new = @{$rfields_new} - 1;
    $line_obj->set_rtokens($rtokens_new);
    $line_obj->set_rpatterns($rpatterns_new);
    $line_obj->set_rfields($rfields_new);
    $line_obj->set_rfield_lengths($rfield_lengths_new);
    $line_obj->set_jmax($jmax_new);

# update list type based on new leading token
    my $old_list_type = $line_obj->get_list_type();
    my $new_list_type = "";
    if ( $rtokens_new->[0] =~ /^(=>|,)/ ) {
        $new_list_type = $rtokens_new->[0];
    }

# An existing list will still be a list but with possibly different leading
    # token
    if ($old_list_type) {
        if ( $old_list_type ne $new_list_type ) {
            $line_obj->set_list_type($new_list_type);
        }
    }

# A non-list line could become a list if all non-list tokens have been
    # deleted. But only do this if the "new_list_ok" flag is set.  The following
    # two-line snippet shows an example of unwanted => alignement which can
    # occur if we promote lines to be lists without permission:
    #  $w1->bin( $xc, $yc,   { Panel => 3 } );
    #  $w1->env( 0, 1, 0, 1, { Axis  => 'Box' } );
    elsif ( $new_list_type && $new_list_ok ) {
        my ( $raw_tok, $lev, $tag, $tok_count ) =
          decode_alignment_token($new_list_type);

# But for lines with leading commas, we will require that they be
        # tagged before converting a line from non-list to a list.
        if ($tag) {
            for ( my $i = 1 ; $i < @{$rtokens_new} - 1 ; $i++ ) {
                if ( $rtokens_new->[$i] !~ /^(,|=>)/ ) {
                    $new_list_type = "";
                    last;
                }
            }
            $line_obj->set_list_type($new_list_type) if ($new_list_type);
        }
    }

$EXPLAIN && print <<EOM;

new jmax: $jmax_new
new tokens: <@{$rtokens_new}>
new patterns: <@{$rpatterns_new}>
new fields: <@{$rfields_new}>
EOM
    return;
}

sub add_dummy_alignment_fields {

# NOTE: This routine is not currently called but it works and is included
    # because it may be used in the future.
    my ( $line_obj, $line_hw, $debug ) = @_;

# Add dummy alignment variables to line $line_obj
    # by copying them from $line_hw.
    #  $line_obj is the line being modified
    #  $line_hw is the line used as an example
    #  $debug is a flag for dumping values during testing

return unless ( defined($line_obj) && defined($line_hw) );

my $jmax_hw           = $line_hw->get_jmax();
    my $rfields_hw        = $line_hw->get_rfields();
    my $rfield_lengths_hw = $line_hw->get_rfield_lengths();
    my $rpatterns_hw      = $line_hw->get_rpatterns();
    my $rtokens_hw        = $line_hw->get_rtokens();

my $num_old = @{$rtokens_old};
    my $num_hw  = @{$rtokens_hw};

print STDERR "num_old=$num_old; num_hw=$num_hw\n";
    print STDERR "Adding; jmax_hw=$jmax_hw, jmax_old=$jmax_old\n";
    $debug = 0;

if ( $jmax_hw < $jmax_old ) {
        print STDERR "unexpected values jmax_old=$jmax_old > jmax_hw=$jmax_hw";
        return;
    }

local $" = ')(';
    $debug && print STDERR <<EOM;
old jmax: $jmax_old
old tokens: <@{$rtokens_old}>
old patterns: <@{$rpatterns_old}>
old fields: <@{$rfields_old}>
old field_lengths: <@{$rfield_lengths_old}>
EOM

my $rfields_new        = [];
    my $rpatterns_new      = [];
    my $rtokens_new        = [];
    my $rfield_lengths_new = [];

my $pattern      = $rpatterns_old->[0];
    my $field        = $rfields_old->[0];
    my $field_length = $rfield_lengths_old->[0];
    push @{$rfields_new},        $field;
    push @{$rfield_lengths_new}, $field_length;
    push @{$rpatterns_new},      $pattern;

for ( my $j = 0 ; $j < $jmax_hw ; $j++ ) {
        my ( $token, $field, $field_length, $pattern );

# copy old fields before the side comment
        if ( $j < $jmax_old - 1 ) {
            $token        = $rtokens_old->[$j];
            $field        = $rfields_old->[ $j + 1 ];
            $field_length = $rfield_lengths_old->[ $j + 1 ];
            $pattern      = $rpatterns_old->[ $j + 1 ];
        }

# copy additional empty felds with same pattern as the model
        elsif ( $j < $jmax_hw - 1 ) {
            $token        = $rtokens_hw->[$j];
            $field        = "";
            $field_length = 0;
            $pattern      = $rpatterns_hw->[ $j + 1 ];
        }

# keep original side comment
        else {
            $token        = $rtokens_old->[ $jmax_old - 1 ];
            $field        = $rfields_old->[$jmax_old];
            $field_length = $rfield_lengths_old->[$jmax_old];
            $pattern      = $rpatterns_old->[$jmax_old];
        }

push @{$rtokens_new},        $token;
        push @{$rfields_new},        $field;
        push @{$rpatterns_new},      $pattern;
        push @{$rfield_lengths_new}, $field_length;

}

# ----- x ------ x ------ x ------
    #t      0        1        2        <- token indexing
    #f   0      1        2        3    <- field and pattern

local $" = ')(';

$debug && print <<EOM;

new jmax: $jmax_new
new tokens: <@{$rtokens_new}>
new patterns: <@{$rpatterns_new}>
new fields: <@{$rfields_new}>
EOM
    return;
}

sub decode_alignment_token {

# Unpack the values packed in an alignment token
    #
    # Usage:
    #        my ( $raw_tok, $lev, $tag, $tok_count ) =
    #          decode_alignment_token($token);

# Alignment tokens have a trailing decimal level and optional tag (for
    # commas):
    # For example, the first comma in the following line
    #     sub banner  { crlf; report( shift, '/', shift ); crlf }
    # is decorated as follows:
    #    ,2+report-6  => (tok,lev,tag) =qw( ,   2   +report-6)

# An optional token count may be appended with a leading dot.
    # Currently this is only done for '=' tokens but this could change.
    # For example, consider the following line:
    #   $nport   = $port = shift || $name;
    # The first '=' may either be '=0' or '=0.1' [level 0, first equals]
    # The second '=' will be '=0.2' [level 0, second equals]
    my ($tok) = @_;
    my ( $raw_tok, $lev, $tag, $tok_count ) = ( $tok, 0, "", 1 );
    if ( $tok =~ /^(\D+)(\d+)([^\.]*)(\.(\d+))?$/ ) {
        $raw_tok   = $1;
        $lev       = $2;
        $tag       = $3 if ($3);
        $tok_count = $5 if ($5);
    }
    return ( $raw_tok, $lev, $tag, $tok_count );
}

{    # sub is_deletable_token

my %is_deletable_equals;

BEGIN {
        my @q;

# These tokens with = may be deleted for vertical aligmnemt
        @q = qw(
          <= >= == =~ != <=>
        );
        @is_deletable_equals{@q} = (1) x scalar(@q);

}

sub is_deletable_token {

# Determine if a token with no match possibility can be removed to
        # improve chances of making an alignment.
        my ( $token, $i, $imax, $jline, $i_eq ) = @_;

my ( $raw_tok, $lev, $tag, $tok_count ) =
          decode_alignment_token($token);

# okay to delete second and higher copies of a token
        if ( $tok_count > 1 ) { return 1 }

# only remove lower level commas
        if ( $raw_tok eq ',' ) {

return if ( defined($i_eq) && $i < $i_eq );
            return if ( $lev <= $group_level );
        }

# most operators with an equals sign should be retained if at
        # same level as this statement
        elsif ( $raw_tok =~ /=/ ) {
            return
              unless ( $lev > $group_level || $is_deletable_equals{$raw_tok} );
        }

# otherwise, ok to delete the token
        return 1;
    }
}

sub delete_unmatched_tokens {
    my ($rlines) = @_;

# This is a preliminary step in vertical alignment in which we remove as
    # many obviously un-needed alignment tokens as possible.  This will prevent
    # them from interfering with the final alignment.

return unless @{$rlines} > 1;

my $has_terminal_match = $rlines->[-1]->get_j_terminal_match();

# ignore hanging side comments in these operations
    my @filtered   = grep { !$_->{_is_hanging_side_comment} } @{$rlines};
    my $rnew_lines = \@filtered;
    my @i_equals;
    my @min_levels;

my $jmax = @{$rnew_lines} - 1;
    return unless $jmax >= 0;

my %is_good_tok;

# create a hash of tokens for each line
    my $rline_hashes = [];
    my $saw_list_type;
    foreach my $line ( @{$rnew_lines} ) {
        my $rhash   = {};
        my $rtokens = $line->get_rtokens();
        if ( !$saw_list_type && $line->get_list_type() ) { $saw_list_type = 1 }
        my $i = 0;
        my $i_eq;
        my $lev_min;
        foreach my $tok ( @{$rtokens} ) {
            my ( $raw_tok, $lev, $tag, $tok_count ) =
              decode_alignment_token($tok);
            if ( !defined($lev_min) || $lev < $lev_min ) { $lev_min = $lev }

# Possible future upgrade: for multiple matches,
            # record [$i1, $i2, ..] instead of $i
            $rhash->{$tok} =
              [ $i, undef, undef, $raw_tok, $lev, $tag, $tok_count ];

# remember the first equals at line level
            if ( !defined($i_eq) && $raw_tok eq '=' ) {
                if ( $lev eq $group_level ) { $i_eq = $i }
            }
            $i++;
        }
        push @{$rline_hashes}, $rhash;
        push @i_equals,   $i_eq;
        push @min_levels, $lev_min;
    }

# compare each line pair and record matches
    my $rtok_hash = {};
    my $nr        = 0;
    for ( my $jl = 0 ; $jl < $jmax ; $jl++ ) {
        my $nl = $nr;
        $nr = 0;
        my $jr      = $jl + 1;
        my $rhash_l = $rline_hashes->[$jl];
        my $rhash_r = $rline_hashes->[$jr];
        my $count   = 0;                      # UNUSED NOW?
        my $ntoks   = 0;
        foreach my $tok ( keys %{$rhash_l} ) {
            $ntoks++;
            if ( defined( $rhash_r->{$tok} ) ) {
                if ( $tok ne '#' ) { $count++; }
                my $il = $rhash_l->{$tok}->[0];
                my $ir = $rhash_r->{$tok}->[0];
                $rhash_l->{$tok}->[2] = $ir;
                $rhash_r->{$tok}->[1] = $il;
                if ( $tok ne '#' ) {
                    push @{ $rtok_hash->{$tok} }, ( $jl, $jr );
                    $nr++;
                }
            }
        }

# Set a line break if no matching tokens between these lines
        if ( $nr == 0 && $nl > 0 ) {
            $rnew_lines->[$jl]->{_end_group} = 1;
        }
    }

# find subgroups
    my @subgroups;
    push @subgroups, [ 0, $jmax ];
    for ( my $jl = 0 ; $jl < $jmax ; $jl++ ) {
        if ( $rnew_lines->[$jl]->{_end_group} ) {
            $subgroups[-1]->[1] = $jl;
            push @subgroups, [ $jl + 1, $jmax ];
        }
    }

# Loop to process each subgroups
    foreach my $item (@subgroups) {
        my ( $jbeg, $jend ) = @{$item};

# look for complete ternary or if/elsif/else blocks
        my $nlines = $jend - $jbeg + 1;
        my %token_line_count;
        for ( my $jj = $jbeg ; $jj <= $jend ; $jj++ ) {
            my %seen;
            my $line    = $rnew_lines->[$jj];
            my $rtokens = $line->get_rtokens();
            foreach my $tok ( @{$rtokens} ) {
                if ( !$seen{$tok} ) {
                    $seen{$tok}++;
                    $token_line_count{$tok}++;
                }
            }
        }

# Look for if/else/elsif and ternary blocks
        my $is_full_block;
        foreach my $tok ( keys %token_line_count ) {
            if ( $token_line_count{$tok} == $nlines ) {
                if ( $tok =~ /^\?/ || $tok =~ /^\{\d+if/ ) {
                    $is_full_block = 1;
                }
            }
        }

# remove unwanted alignment tokens
        for ( my $jj = $jbeg ; $jj <= $jend ; $jj++ ) {
            my $line    = $rnew_lines->[$jj];
            my $rtokens = $line->get_rtokens();
            my $rhash   = $rline_hashes->[$jj];
            my $i_eq    = $i_equals[$jj];
            my @idel;
            my $imax = @{$rtokens} - 2;
            my $delete_above_level;

for ( my $i = 0 ; $i <= $imax ; $i++ ) {
                my $tok = $rtokens->[$i];
                next if ( $tok eq '#' );    # shouldn't happen
                my ( $iii, $il, $ir, $raw_tok, $lev, $tag, $tok_count ) =
                  @{ $rhash->{$tok} };

# always remove unmatched tokens
                my $delete_me = !defined($il) && !defined($ir);

# also, if this is a complete ternary or if/elsif/else block,
                # remove all alignments which are not also in every line
                $delete_me ||=
                  ( $is_full_block && $token_line_count{$tok} < $nlines );

# Remove all tokens above a certain level following a previous
                # deletion.  For example, we have to remove tagged higher level
                # alignment tokens following a => deletion because the tags of
                # higher level tokens will now be incorrect. For example, this
                # will prevent aligning commas as follows after deleting the
                # second =>
                #    $w->insert(
                #	ListBox => origin => [ 270, 160 ],
                #	size    => [ 200,           55 ],
                #    );
                if ( defined($delete_above_level) ) {
                    if ( $lev > $delete_above_level ) {
                        $delete_me ||= 1;    #$tag;
                    }
                    else { $delete_above_level = undef }
                }

if (
                    $delete_me
                    && is_deletable_token( $tok, $i, $imax, $jj, $i_eq )

# Patch: do not touch the first line of a terminal match,
                    # such as below, because j_terminal has already been set.
                    #    if ($tag) { $tago = "<$tag>"; $tagc = "</$tag>"; }
                    #    else      { $tago = $tagc = ''; }
                    # But see snippets 'else1.t' and 'else2.t'
                    && !( $jj == $jbeg && $has_terminal_match && $nlines == 2 )

)
                {
                    push @idel, $i;
                    if ( !defined($delete_above_level)
                        || $lev < $delete_above_level )
                    {

# delete all following higher level alignments
                        $delete_above_level = $lev;

# but keep deleting after => to next lower level
                        # to avoid some bizarre alignments
                        if ( $raw_tok eq '=>' ) {
                            $delete_above_level = $lev - 1;
                        }
                    }
                }
            }

if (@idel) {
                delete_selected_tokens( $line, \@idel, $saw_list_type );
            }
        }

}    # End loop over subgroups

fix_ragged_matches($rlines) if ($saw_list_type);

return;
}

{        # fix_ragged_matches

my %is_comma_or_comment;
    my $BLOCK_MERGE_RATIO;
    my $EXPLAIN;

BEGIN {
        my @q;

@q = ( ',', '=>', '#' );
        @is_comma_or_comment{@q} = (1) x scalar(@q);

# This fraction controls merges. Only merge a long block into a shorter
        # block if the ratio of the number of lines is less than this ratio.
        # The idea is to avoid merging away a significant block that would
        # otherwise be aligned.  This is not a critical parameter.  Some
        # testing showed that it is best between about 0.3 and 0.5.  The
        # original test snippet, git25, worked best with a value >=0.35.
        $BLOCK_MERGE_RATIO = 0.5;

# Debug flag
        $EXPLAIN = 0;
    }

sub fix_ragged_matches {
        my ($rlines) = @_;

return unless @{$rlines} > 2;

# Look at a group of lines and see if there are ragged matches
        # which can be improved by adjusting alignments.

# TODO: This version only treats lists.  It might be generalized
        # to handle more types of matches.

#########################################################
        # Step 1. Start by scanning the lines and collecting info
        #########################################################
        # For each line, save:  [is_list, imax_match]
        #   is_list=a flag showing if it is a pure list,
        #   imax_match = the index of the highest matching alignment token
        my $ri_list_info = [];
        my $rtokens;
        my $imax;
        my $in_match = 0;
        my $jj       = -1;

foreach my $line ( @{$rlines} ) {

# _m = previous line
            my $rtokens_m = $rtokens;
            my $imax_m    = $imax;
            my $jj_m      = $jj;

$jj++;
            $rtokens = $line->get_rtokens();
            $imax    = @{$rtokens} - 2;        # max i before comment
            my $list_type = $line->get_list_type();

# No matches if there is a group ending flag set between these lines
            my $end_group = ( $jj_m >= 0 && $rlines->[$jj_m]->{_end_group} );

# Also skip past a non-list line; we are working on pure lists here
            if ( $end_group || !$list_type ) {
                push @{$ri_list_info}, [ 0, -1 ];
                next;
            }

# Loop to examine tokens of each line
            my $i_nomatch;
            my $is_list    = $imax >= 0;
            my $i          = -1;
            my $imax_match = -1;

foreach my $tok ( @{$rtokens} ) {
                $i++;
                last if ( $i > $imax );
                my ( $raw_tok, $lev, $tag, $tok_count ) =
                  decode_alignment_token($tok);

# Look for lines which are lists
                if ( $is_list && !$is_comma_or_comment{$raw_tok} ) {
                    $is_list = 0;
                    last;
                }

# Look for index of first token which does not match the
                # previous line
                if ( defined($rtokens_m) ) {
                    if ( $i > $imax_m ) { last; }
                    my $tokm = $rtokens_m->[$i];
                    last if ( $tok ne $tokm );
                }
                $imax_match = $i;
            }

# Save the last index of leading matches to the previous line
            push @{$ri_list_info}, [ $is_list, $imax_match ];
        }

##########################################################
        # Step 2. Combine runs of equal length matches into blocks
        ##########################################################
        my @match_blocks;

# Each block in @match_blocks contains [jbeg, jend, imax_match], where
        # jbeg = line index of first line of block
        # jend = line index of last line of block
        # imax_match = index of maximum alignment token for lines in this batch.
        #    This value applies to matches between all lines j=jbeg to jend and
        #    j=jbeg-1 to jend-1.  In other words, the value for a pair of lines
        #    is stored with the line with the higher index.
        my $imatch      = -10;
        my $j_last_line = @{$rlines} - 1;
        my %counts;
        my $total_match_count = 0;
        my $all_list_lines    = 1;
        for ( my $jr = 1 ; $jr <= $j_last_line ; $jr++ ) {
            my $jl = $jr - 1;
            my ( $is_list, $imax_match ) = @{ $ri_list_info->[$jr] };
            if ( !$is_list ) { $all_list_lines = 0 }
            $counts{$imax_match}++;
            $total_match_count += $imax_match + 2;

# look at total variation of fields
            my $nl = $rlines->[$jl]->get_jmax();
            my $nr = $rlines->[$jr]->get_jmax();

$imax_match = -1 unless ($is_list);
            if ( $imax_match != $imatch ) {
                if (@match_blocks) {
                    $match_blocks[-1]->[1] = $jr - 1;
                }

push @match_blocks, [ $jl, $j_last_line, $imax_match, 0 ];
                $imatch = $imax_match;
            }
        }

if ($EXPLAIN) {
            print "Blocks Before Merging:\n";
            local $" = ')(';
            foreach (@match_blocks) {
                print "Block: (@{$_})\n";
            }
        }

############################################################
        # Step 3. Try to improve overall alignment by merging blocks
        ############################################################

# Loop over iterations; it usually just takes one pass but it may
        # occasionally take 2 iterations.
        for ( my $it = 0 ; $it < 3 ; $it++ ) {

# quit if no more matches possible
            last unless ( @match_blocks > 1 );

# loop over blocks
            my @new_match_blocks = ();
            my $merge_count      = 0;
            for ( my $ib = 0 ; $ib < @match_blocks ; $ib++ ) {
                my $block = $match_blocks[$ib];
                my ( $jmin, $jmax, $imatch ) = @{$block};
                my $num = $jmax - $jmin;

# Skip no-match blocks
                next if ( $imatch < 0 );

# pull out values for previous block
                my ( $block_m, $jmin_m, $jmax_m, $imatch_m, $num_m );
                if (@new_match_blocks) {
                    $block_m = $new_match_blocks[-1];
                    ( $jmin_m, $jmax_m, $imatch_m ) = @{$block_m};
                    $num_m = $jmax_m - $jmin_m;
                }

# See if we can merge this block into a previous block which
                # has an equal or fewer number of aligned fields.  The combined
                # block will have the lesser number of alignments.  We will
                # only do this if it will help overall alignment.
                if ( defined($block_m) && $imatch >= $imatch_m ) {

# Always ok to merge blocks with an equal number of
                    # alignments.  This can occur if we previously removed an
                    # intermediate larger block.
                    my $merge_ok = ( $imatch == $imatch_m );

# And it is ok to merge if the fraction of lines of the
                    # block being modified is acceptably small.
                    $merge_ok ||= $num < $BLOCK_MERGE_RATIO * $num_m;

# If necessary, look for a sandwich situation at next block
                    # and recompute assuming all three merge.
                    if ( !$merge_ok && $ib < @match_blocks - 1 ) {
                        my $block_p = $match_blocks[ $ib + 1 ];
                        my ( $jmin_p, $jmax_p, $imatch_p ) = @{$block_p};
                        if ( $imatch_p == $imatch_m ) {
                            my $num_p = $jmax_p - $jmin_p;
                            $merge_ok ||=
                              $num < $BLOCK_MERGE_RATIO * ( $num_m + $num_p );
                        }
                    }

if ($merge_ok) {

# We are only merging with the previous block. In a
                        # sandwich merge, the next block will merge in the next
                        # pass through the loop.
                        $block_m = [ $jmin_m, $jmax, $imatch_m ];
                        $new_match_blocks[-1] = $block_m;
                        $merge_count++;
                        $EXPLAIN > 2
                          && print
"Merged block # $ib into previous block; #lines $num into $num_m, #matches $imatch into $imatch_m, it=$it\n";
                        next;
                    }
                }
                push @new_match_blocks, $block;
            }
            @match_blocks = @new_match_blocks;
            $EXPLAIN > 2 && print "it=$it, merged block count = $merge_count\n";
            last if ( $merge_count == 0 );
        }

if ($EXPLAIN) {
            print "Blocks After Merging:\n";
            local $" = ')(';
            foreach (@match_blocks) {
                print "Block: (@{$_})\n";
            }
        }

#######################################################################
        # Step 4. Trim away alignments which extend beyond the block alignments
        #######################################################################
        my ( $jbeg, $jend, $imax_match );
        for ( my $ib = 0 ; $ib < @match_blocks ; $ib++ ) {
            my $block = $match_blocks[$ib];
            my ( $jbeg_m, $jend_m, $imax_match_m ) =
              ( $jbeg, $jend, $imax_match );
            ( $jbeg, $jend, $imax_match ) = @{$block};

next unless ( $imax_match >= 0 );

# We will ignore a group of two lines. These are already well
            # covered by existing logic, and we can only make things worse.
            next unless ( $jend - $jbeg > 1 );

if (   $jbeg > 0
                && defined($imax_match_m)
                && $imax_match > $imax_match_m
                && $imax_match_m >= 0 )
            {
                $rlines->[ $jbeg - 1 ]->{_end_group} = 1;
                $EXPLAIN > 2 && print "Marked group end before line $jbeg\n";
            }

# remove unused alignment tokens
            for ( my $jj = $jbeg ; $jj <= $jend ; $jj++ ) {
                my $line    = $rlines->[$jj];
                my $rtokens = $line->get_rtokens();
                my $imax    = @{$rtokens} - 2;
                my $tok     = $rtokens->[0];

# The first line of a block is handled by previous block except
                # for the first line.  There are no gaps between blocks, so all
                # lines will be handled.
                next if ( $jj == $jbeg && $jj > 0 );

# A boundary line is trimmed to the larger of its surrounding
                # match lengths:
                my $imax_match_j = $imax_match;

# First line checks previous block
                if (   $jj == $jbeg
                    && defined($imax_match_m)
                    && $imax_match_m > $imax_match_j )
                {
                    $imax_match_j = $imax_match_m;
                }

# Last line checks next block
                if ( $jj == $jend && $ib < @match_blocks - 1 ) {
                    my $block_p = $match_blocks[ $ib + 1 ];
                    my ( $jmin_p, $jmax_p, $imax_match_p ) = @{$block_p};
                    if ( $imax_match_p > $imax_match_j ) {
                        $imax_match_j = $imax_match_p;
                    }
                }

# Now delete the unused alignment tokens

# NOTE: We are currently only working on lists, so we can allow
             # lines to be promoted as lists.  But if this coding is generalized
             # this flag may have to be adjusted to handle or non-lists.
                my $new_list_ok = 1;

if ( $imax_match_j < $imax ) {
                    my @idel = ( $imax_match_j + 1 .. $imax );
                    delete_selected_tokens( $line, \@idel, $new_list_ok );
                }
            }
        }
        return;
    }
}

{    # decide_if_aligned_pair

my %is_if_or;
    my %is_assignment;

BEGIN {

my @q = qw(
          if unless or ||
        );
        @is_if_or{@q} = (1) x scalar(@q);

@q = qw(
          = **= += *= &= <<= &&=
          -= /= |= >>= ||= //=
          .= %= ^=
          x=
        );
        @is_assignment{@q} = (1) x scalar(@q);
    }

sub decide_if_aligned_pair {

# Do not try to align two lines which are not really similar
        return unless ( @group_lines == 2 );
        return if ($is_matching_terminal_line);

# always align lists
        my $group_list_type = $group_lines[0]->get_list_type();
        return 0 if ($group_list_type);

my $jmax0          = $group_lines[0]->get_jmax();
        my $jmax1          = $group_lines[1]->get_jmax();
        my $rtokens        = $group_lines[0]->get_rtokens();
        my $leading_equals = ( $rtokens->[0] =~ /=/ );

# scan the tokens on the second line
        my $rtokens1 = $group_lines[1]->get_rtokens();
        my $saw_if_or;    # if we saw an 'if' or 'or' at group level
        my $raw_tokb = "";    # first token seen at group level
        for ( my $j = 0 ; $j < $jmax1 - 1 ; $j++ ) {
            my ( $raw_tok, $lev, $tag, $tok_count ) =
              decode_alignment_token( $rtokens1->[$j] );
            if ( $raw_tok && $lev == $group_level ) {
                if ( !$raw_tokb ) { $raw_tokb = $raw_tok }
                $saw_if_or ||= $is_if_or{$raw_tok};
            }
        }

# A marginal match is a match which has different patterns. Normally,
        # we should not allow exactly two lines to match if marginal. But
        # we can allow matching in some specific cases.
        my $is_marginal = $marginal_match;

# lines with differing number of alignment tokens are marginal
        $is_marginal ||=
          $previous_maximum_jmax_seen != $previous_minimum_jmax_seen
          && !$is_assignment{$raw_tokb};

# We will use the line endings to help decide on alignments...
        # See if the lines end with semicolons...
        my $rpatterns0 = $group_lines[0]->get_rpatterns();
        my $rpatterns1 = $group_lines[1]->get_rpatterns();
        my $sc_term0;
        my $sc_term1;
        if ( $jmax0 < 1 || $jmax1 < 1 ) {

# shouldn't happen
        }
        else {
            my $pat0 = $rpatterns0->[ $jmax0 - 1 ];
            my $pat1 = $rpatterns1->[ $jmax1 - 1 ];
            $sc_term0 = $pat0 =~ /;b?$/;
            $sc_term1 = $pat1 =~ /;b?$/;
        }

if ( !$is_marginal && !$sc_term0 ) {

# First line of assignment should be semicolon terminated.
            # For example, do not align here:
            #  $$href{-NUM_TEXT_FILES} = $$href{-NUM_BINARY_FILES} =
            #    $$href{-NUM_DIRS} = 0;
            if ( $is_assignment{$raw_tokb} ) {
                $is_marginal = 1;
            }
        }

# Try to avoid some undesirable alignments of opening tokens
        # for example, the space between grep and { here:
        #  return map { ( $_ => $_ ) }
        #    grep     { /$handles/ } $self->_get_delegate_method_list;
        $is_marginal ||=
             ( $raw_tokb eq '(' || $raw_tokb eq '{' )
          && $jmax1 == 2
          && $sc_term0 ne $sc_term1;

# Undo the marginal match flag in certain cases,
        if ($is_marginal) {

# Two lines with a leading equals-like operator are allowed to
            # align if the patterns to the left of the equals are the same.
            # For example the following two lines are a marginal match but have
            # the same left side patterns, so we will align the equals.
            #     my $orig = my $format = "^<<<<< ~~\n";
            #     my $abc  = "abc";
            # But these have a different left pattern so they will not be
            # aligned
            #     $xmldoc .= $`;
            #     $self->{'leftovers'} .= "<bx-seq:seq" . $';

# First line semicolon terminated but second not, usually ok:
            #               my $want = "'ab', 'a', 'b'";
            #               my $got  = join( ", ",
            #                    map { defined($_) ? "'$_'" : "undef" }
            #                          @got );
            #  First line not semicolon terminated, Not OK to match:
            #   $$href{-NUM_TEXT_FILES} = $$href{-NUM_BINARY_FILES} =
            #      $$href{-NUM_DIRS} = 0;
            my $pat0 = $rpatterns0->[0];
            my $pat1 = $rpatterns1->[0];

##########################################################
            # Turn off the marginal flag for some types of assignments
            ##########################################################
            if ( $is_assignment{$raw_tokb} ) {

# undo marginal flag if first line is semicolon terminated
                # and leading patters match
                if ($sc_term0) {    # && $sc_term1) {
                    $is_marginal = $pat0 ne $pat1;
                }
            }
            elsif ( $raw_tokb eq '=>' ) {

# undo marginal flag if patterns match
                $is_marginal = $pat0 ne $pat1;
            }
            elsif ( $raw_tokb eq '=~' ) {

# undo marginal flag if both lines are semicolon terminated
                # and leading patters match
                if ( $sc_term1 && $sc_term0 ) {
                    $is_marginal = $pat0 ne $pat1;
                }
            }

######################################################
            # Turn off the marginal flag if we saw an 'if' or 'or'
            ######################################################

# A trailing 'if' and 'or' often gives a good alignment
            # For example, we can align these:
            #  return -1     if $_[0] =~ m/^CHAPT|APPENDIX/;
            #  return $1 + 0 if $_[0] =~ m/^SECT(\d*)$/;

# or
            #  $d_in_m[2] = 29          if ( &Date_LeapYear($y) );
            #  $d         = $d_in_m[$m] if ( $d > $d_in_m[$m] );

if ($saw_if_or) {

# undo marginal flag if both lines are semicolon terminated
                if ( $sc_term0 && $sc_term1 ) {
                    $is_marginal = 0;
                }
            }
        }

###############################
        # Set the return flag:
        # Don't align if still marginal
        ###############################
        my $do_not_align = $is_marginal;

# But try to convert them into a simple comment group if the first line
        # a has side comment
        my $rfields             = $group_lines[0]->get_rfields();
        my $rfield_lengths      = $group_lines[0]->get_rfield_lengths();
        my $maximum_field_index = $group_lines[0]->get_jmax();
        if (   $do_not_align
            && $rfield_lengths->[$maximum_field_index] > 0 )
        {
            combine_fields();
            $do_not_align = 0;
        }
        return $do_not_align;
    }
}

sub adjust_side_comment {

my $do_not_align = shift;

# let's see if we can move the side comment field out a little
    # to improve readability (the last field is always a side comment field)
    my $have_side_comment       = 0;
    my $first_side_comment_line = -1;
    my $maximum_field_index     = $group_lines[0]->get_jmax();
    my $i                       = 0;
    foreach my $line (@group_lines) {
        if ( $line->get_rfield_lengths()->[$maximum_field_index] ) {
            $have_side_comment       = 1;
            $first_side_comment_line = $i;
            last;
        }
        $i++;
    }

my $kmax = $maximum_field_index + 1;

if ($have_side_comment) {

my $line = $group_lines[0];

# the maximum space without exceeding the line length:
        my $avail = $line->get_available_space_on_right();

# try to use the previous comment column
        my $side_comment_column = $line->get_column( $kmax - 2 );
        my $move                = $last_comment_column - $side_comment_column;

##        my $sc_line0 = $side_comment_history[0]->[0];
##        my $sc_col0  = $side_comment_history[0]->[1];
##        my $sc_line1 = $side_comment_history[1]->[0];
##        my $sc_col1  = $side_comment_history[1]->[1];
##        my $sc_line2 = $side_comment_history[2]->[0];
##        my $sc_col2  = $side_comment_history[2]->[1];
##
##        # FUTURE UPDATES:
##        # Be sure to ignore 'do not align' and  '} # end comments'
##        # Find first $move > 0 and $move <= $avail as follows:
##        # 1. try sc_col1 if sc_col1 == sc_col0 && (line-sc_line0) < 12
##        # 2. try sc_col2 if (line-sc_line2) < 12
##        # 3. try min possible space, plus up to 8,
##        # 4. try min possible space

if ( $kmax > 0 && !$do_not_align ) {

# but if this doesn't work, give up and use the minimum space
            if ( $move > $avail ) {
                $move = $rOpts_minimum_space_to_comment - 1;
            }

# but we want some minimum space to the comment
            my $min_move = $rOpts_minimum_space_to_comment - 1;
            if (   $move >= 0
                && $last_side_comment_length > 0
                && ( $first_side_comment_line == 0 )
                && $group_level == $last_level_written )
            {
                $min_move = 0;
            }

if ( $move < $min_move ) {
                $move = $min_move;
            }

# previously, an upper bound was placed on $move here,
            # (maximum_space_to_comment), but it was not helpful

# don't exceed the available space
            if ( $move > $avail ) { $move = $avail }

# we can only increase space, never decrease
            if ( $move > 0 ) {
                $line->increase_field_width( $maximum_field_index - 1, $move );
            }

# remember this column for the next group
            $last_comment_column = $line->get_column( $kmax - 2 );
        }
        else {

# try to at least line up the existing side comment location
            if ( $kmax > 0 && $move > 0 && $move < $avail ) {
                $line->increase_field_width( $maximum_field_index - 1, $move );
                $do_not_align = 0;
            }

# reset side comment column if we can't align
            else {
                forget_side_comment();
            }
        }
    }
    return $do_not_align;
}

sub valign_output_step_A {

###############################################################
    # This is Step A in writing vertically aligned lines.
    # The line is prepared according to the alignments which have
    # been found. Then it is shipped to the next step.
    ###############################################################

my %input_hash = @_;

my $line                 = $input_hash{line};
    my $min_ci_gap           = $input_hash{min_ci_gap};
    my $do_not_align         = $input_hash{do_not_align};
    my $group_leader_length  = $input_hash{group_leader_length};
    my $extra_leading_spaces = $input_hash{extra_leading_spaces};

my $rfields                   = $line->get_rfields();
    my $rfield_lengths            = $line->get_rfield_lengths();
    my $leading_space_count       = $line->get_leading_space_count();
    my $outdent_long_lines        = $line->get_outdent_long_lines();
    my $maximum_field_index       = $line->get_jmax();
    my $rvertical_tightness_flags = $line->get_rvertical_tightness_flags();

# add any extra spaces
    if ( $leading_space_count > $group_leader_length ) {
        $leading_space_count += $min_ci_gap;
    }

my $str     = $rfields->[0];
    my $str_len = $rfield_lengths->[0];

# loop to concatenate all fields of this line and needed padding
    my $total_pad_count = 0;
    for my $j ( 1 .. $maximum_field_index ) {

# skip zero-length side comments
        last
          if (
            ( $j == $maximum_field_index )
            && ( !defined( $rfields->[$j] )
                || ( $rfield_lengths->[$j] == 0 ) )
          );

# compute spaces of padding before this field
        my $col = $line->get_column( $j - 1 );
        my $pad = $col - ( $str_len + $leading_space_count );

if ($do_not_align) {
            $pad =
              ( $j < $maximum_field_index )
              ? 0
              : $rOpts_minimum_space_to_comment - 1;
        }

# if the -fpsc flag is set, move the side comment to the selected
        # column if and only if it is possible, ignoring constraints on
        # line length and minimum space to comment
        if ( $rOpts_fixed_position_side_comment && $j == $maximum_field_index )
        {
            my $newpad = $pad + $rOpts_fixed_position_side_comment - $col - 1;
            if ( $newpad >= 0 ) { $pad = $newpad; }
        }

# accumulate the padding
        if ( $pad > 0 ) { $total_pad_count += $pad; }

# add this field
        if ( !defined $rfields->[$j] ) {
            write_diagnostics("UNDEFined field at j=$j\n");
        }

# only add padding when we have a finite field;
        # this avoids extra terminal spaces if we have empty fields
        if ( $rfield_lengths->[$j] > 0 ) {
            $str .= ' ' x $total_pad_count;
            $str_len += $total_pad_count;
            $total_pad_count = 0;
            $str .= $rfields->[$j];
            $str_len += $rfield_lengths->[$j];
        }
        else {
            $total_pad_count = 0;
        }

# update side comment history buffer
        if ( $j == $maximum_field_index ) {
            my $lineno = $file_writer_object->get_output_line_number();
            shift @side_comment_history;
            push @side_comment_history, [ $lineno, $col ];
        }
    }

my $side_comment_length = $rfield_lengths->[$maximum_field_index];

# ship this line off
    valign_output_step_B(
        leading_space_count => $leading_space_count + $extra_leading_spaces,
        line                => $str,
        line_length         => $str_len,
        side_comment_length => $side_comment_length,
        outdent_long_lines  => $outdent_long_lines,
        rvertical_tightness_flags => $rvertical_tightness_flags,
        level                     => $group_level,
    );
    return;
}

sub get_extra_leading_spaces {

#----------------------------------------------------------
    # Define any extra indentation space (for the -lp option).
    # Here is why:
    # If a list has side comments, sub scan_list must dump the
    # list before it sees everything.  When this happens, it sets
    # the indentation to the standard scheme, but notes how
    # many spaces it would have liked to use.  We may be able
    # to recover that space here in the event that all of the
    # lines of a list are back together again.
    #----------------------------------------------------------

my $extra_leading_spaces = 0;
    if ($extra_indent_ok) {
        my $object = $group_lines[0]->get_indentation();
        if ( ref($object) ) {
            my $extra_indentation_spaces_wanted =
              get_recoverable_spaces($object);

# all indentation objects must be the same
            for my $i ( 1 .. @group_lines - 1 ) {
                if ( $object != $group_lines[$i]->get_indentation() ) {
                    $extra_indentation_spaces_wanted = 0;
                    last;
                }
            }

if ($extra_indentation_spaces_wanted) {

# the maximum space without exceeding the line length:
                my $avail = $group_lines[0]->get_available_space_on_right();
                $extra_leading_spaces =
                  ( $avail > $extra_indentation_spaces_wanted )
                  ? $extra_indentation_spaces_wanted
                  : $avail;

# update the indentation object because with -icp the terminal
                # ');' will use the same adjustment.
                $object->permanently_decrease_available_spaces(
                    -$extra_leading_spaces );
            }
        }
    }
    return $extra_leading_spaces;
}

sub combine_fields {

# combine all fields except for the comment field  ( sidecmt.t )
    # Uses global variables:
    #  @group_lines
    my $maximum_field_index = $group_lines[0]->get_jmax();
    foreach my $line (@group_lines) {
        my $rfields        = $line->get_rfields();
        my $rfield_lengths = $line->get_rfield_lengths();
        foreach ( 1 .. $maximum_field_index - 1 ) {
            $rfields->[0] .= $rfields->[$_];
            $rfield_lengths->[0] += $rfield_lengths->[$_];
        }
        $rfields->[1]        = $rfields->[$maximum_field_index];
        $rfield_lengths->[1] = $rfield_lengths->[$maximum_field_index];

$line->set_jmax(1);
        $line->set_column( 0, 0 );
        $line->set_column( 1, 0 );

}
    $maximum_field_index = 1;

foreach my $line (@group_lines) {
        my $rfields        = $line->get_rfields();
        my $rfield_lengths = $line->get_rfield_lengths();
        for my $k ( 0 .. $maximum_field_index ) {
            my $pad = $rfield_lengths->[$k] - $line->current_field_width($k);
            if ( $k == 0 ) {
                $pad += $line->get_leading_space_count();
            }

if ( $pad > 0 ) { $line->increase_field_width( $k, $pad ) }

}
    }
    return;
}

sub get_output_line_number {

# the output line number reported to a caller is the number of items
    # written plus the number of items in the buffer
    my $self   = shift;
    my $nlines = @group_lines;
    return $nlines + $file_writer_object->get_output_line_number();
}

sub valign_output_step_B {

###############################################################
    # This is Step B in writing vertically aligned lines.
    # Vertical tightness is applied according to preset flags.
    # In particular this routine handles stacking of opening
    # and closing tokens.
    ###############################################################

my %input_hash = @_;

my $leading_space_count       = $input_hash{leading_space_count};
    my $str                       = $input_hash{line};
    my $str_length                = $input_hash{line_length};
    my $side_comment_length       = $input_hash{side_comment_length};
    my $outdent_long_lines        = $input_hash{outdent_long_lines};
    my $rvertical_tightness_flags = $input_hash{rvertical_tightness_flags};
    my $level                     = $input_hash{level};

# Useful -gcs test cases for wide characters are
    # perl527/(method.t.2, reg_mesg.t, mime-header.t)

# handle outdenting of long lines:
    if ($outdent_long_lines) {
        my $excess =
          $str_length -
          $side_comment_length +
          $leading_space_count -
          maximum_line_length_for_level($level);
        if ( $excess > 0 ) {
            $leading_space_count = 0;
            $last_outdented_line_at =
              $file_writer_object->get_output_line_number();

unless ($outdented_line_count) {
                $first_outdented_line_at = $last_outdented_line_at;
            }
            $outdented_line_count++;
        }
    }

# Make preliminary leading whitespace.  It could get changed
    # later by entabbing, so we have to keep track of any changes
    # to the leading_space_count from here on.
    my $leading_string =
      $leading_space_count > 0 ? ( ' ' x $leading_space_count ) : "";
    my $leading_string_length = length($leading_string);

# Unpack any recombination data; it was packed by
    # sub send_lines_to_vertical_aligner. Contents:
    #
    #   [0] type: 1=opening non-block    2=closing non-block
    #             3=opening block brace  4=closing block brace
    #   [1] flag: if opening: 1=no multiple steps, 2=multiple steps ok
    #             if closing: spaces of padding to use
    #   [2] sequence number of container
    #   [3] valid flag: do not append if this flag is false
    #
    my ( $open_or_close, $tightness_flag, $seqno, $valid, $seqno_beg,
        $seqno_end );
    if ($rvertical_tightness_flags) {
        (
            $open_or_close, $tightness_flag, $seqno, $valid, $seqno_beg,
            $seqno_end
        ) = @{$rvertical_tightness_flags};
    }

$seqno_string = $seqno_end;

# handle any cached line ..
    # either append this line to it or write it out
    # Note: the function length() is used in this next test out of caution.
    # All testing has shown that the variable $cached_line_text_length is
    # correct, but its calculation is complex and a loss of cached text would
    # be a disaster.
    if ( length($cached_line_text) ) {

# Dump an invalid cached line
        if ( !$cached_line_valid ) {
            valign_output_step_C( $cached_line_text,
                $cached_line_leading_space_count,
                $last_level_written );
        }

# Handle cached line ending in OPENING tokens
        elsif ( $cached_line_type == 1 || $cached_line_type == 3 ) {

my $gap = $leading_space_count - $cached_line_text_length;

# handle option of just one tight opening per line:
            if ( $cached_line_flag == 1 ) {
                if ( defined($open_or_close) && $open_or_close == 1 ) {
                    $gap = -1;
                }
            }

if ( $gap >= 0 && defined($seqno_beg) ) {
                $leading_string        = $cached_line_text . ' ' x $gap;
                $leading_string_length = $cached_line_text_length + $gap;
                $leading_space_count   = $cached_line_leading_space_count;
                $seqno_string = $cached_seqno_string . ':' . $seqno_beg;
                $level        = $last_level_written;
            }
            else {
                valign_output_step_C( $cached_line_text,
                    $cached_line_leading_space_count,
                    $last_level_written );
            }
        }

# Handle cached line ending in CLOSING tokens
        else {
            my $test_line = $cached_line_text . ' ' x $cached_line_flag . $str;
            my $test_line_length =
              $cached_line_text_length + $cached_line_flag + $str_length;
            if (

# The new line must start with container
                $seqno_beg

# The container combination must be okay..
                && (

# okay to combine like types
                    ( $open_or_close == $cached_line_type )

# closing block brace may append to non-block
                    || ( $cached_line_type == 2 && $open_or_close == 4 )

# something like ');'
                    || ( !$open_or_close && $cached_line_type == 2 )

)

# The combined line must fit
                && ( $test_line_length <=
                    maximum_line_length_for_level($last_level_written) )
              )
            {

$seqno_string = $cached_seqno_string . ':' . $seqno_beg;

# Patch to outdent closing tokens ending # in ');'
                # If we are joining a line like ');' to a previous stacked
                # set of closing tokens, then decide if we may outdent the
                # combined stack to the indentation of the ');'.  Since we
                # should not normally outdent any of the other tokens more than
                # the indentation of the lines that contained them, we will
                # only do this if all of the corresponding opening
                # tokens were on the same line.  This can happen with
                # -sot and -sct.  For example, it is ok here:
                #   __PACKAGE__->load_components( qw(
                #         PK::Auto
                #         Core
                #   ));
                #
                #   But, for example, we do not outdent in this example because
                #   that would put the closing sub brace out farther than the
                #   opening sub brace:
                #
                #   perltidy -sot -sct
                #   $c->Tk::bind(
                #       '<Control-f>' => sub {
                #           my ($c) = @_;
                #           my $e = $c->XEvent;
                #           itemsUnderArea $c;
                #       } );
                #
                if ( $str =~ /^\);/ && $cached_line_text =~ /^[\)\}\]\s]*$/ ) {

# The way to tell this is if the stacked sequence numbers
                    # of this output line are the reverse of the stacked
                    # sequence numbers of the previous non-blank line of
                    # sequence numbers.  So we can join if the previous
                    # nonblank string of tokens is the mirror image.  For
                    # example if stack )}] is 13:8:6 then we are looking for a
                    # leading stack like [{( which is 6:8:13 We only need to
                    # check the two ends, because the intermediate tokens must
                    # fall in order.  Note on speed: having to split on colons
                    # and eliminate multiple colons might appear to be slow,
                    # but it's not an issue because we almost never come
                    # through here.  In a typical file we don't.
                    $seqno_string               =~ s/^:+//;
                    $last_nonblank_seqno_string =~ s/^:+//;
                    $seqno_string               =~ s/:+/:/g;
                    $last_nonblank_seqno_string =~ s/:+/:/g;

# how many spaces can we outdent?
                    my $diff =
                      $cached_line_leading_space_count - $leading_space_count;
                    if (   $diff > 0
                        && length($seqno_string)
                        && length($last_nonblank_seqno_string) ==
                        length($seqno_string) )
                    {
                        my @seqno_last =
                          ( split /:/, $last_nonblank_seqno_string );
                        my @seqno_now = ( split /:/, $seqno_string );
                        if (   @seqno_now
                            && @seqno_last
                            && $seqno_now[-1] == $seqno_last[0]
                            && $seqno_now[0] == $seqno_last[-1] )
                        {

# OK to outdent ..
                            # for absolute safety, be sure we only remove
                            # whitespace
                            my $ws = substr( $test_line, 0, $diff );
                            if ( ( length($ws) == $diff ) && $ws =~ /^\s+$/ ) {

$test_line = substr( $test_line, $diff );
                                $cached_line_leading_space_count -= $diff;
                                $last_level_written =
                                  level_change(
                                    $cached_line_leading_space_count,
                                    $diff, $last_level_written );
                                reduce_valign_buffer_indentation($diff);
                            }

# shouldn't happen, but not critical:
                            ##else {
                            ## ERROR transferring indentation here
                            ##}
                        }
                    }
                }

$str                   = $test_line;
                $str_length            = $test_line_length;
                $leading_string        = "";
                $leading_string_length = 0;
                $leading_space_count   = $cached_line_leading_space_count;
                $level                 = $last_level_written;
            }
            else {
                valign_output_step_C( $cached_line_text,
                    $cached_line_leading_space_count,
                    $last_level_written );
            }
        }
    }
    $cached_line_type        = 0;
    $cached_line_text        = "";
    $cached_line_text_length = 0;

# make the line to be written
    my $line        = $leading_string . $str;
    my $line_length = $leading_string_length + $str_length;

# write or cache this line
    if ( !$open_or_close || $side_comment_length > 0 ) {
        valign_output_step_C( $line, $leading_space_count, $level );
    }
    else {
        $cached_line_text                = $line;
        $cached_line_text_length         = $line_length;
        $cached_line_type                = $open_or_close;
        $cached_line_flag                = $tightness_flag;
        $cached_seqno                    = $seqno;
        $cached_line_valid               = $valid;
        $cached_line_leading_space_count = $leading_space_count;
        $cached_seqno_string             = $seqno_string;
    }

$last_level_written       = $level;
    $last_side_comment_length = $side_comment_length;
    $extra_indent_ok          = 0;
    return;
}

sub valign_output_step_C {

###############################################################
    # This is Step C in writing vertically aligned lines.
    # Lines are either stored in a buffer or passed along to the next step.
    # The reason for storing lines is that we may later want to reduce their
    # indentation when -sot and -sct are both used.
    ###############################################################
    my @args = @_;

# Dump any saved lines if we see a line with an unbalanced opening or
    # closing token.
    dump_valign_buffer() if ( $seqno_string && $valign_buffer_filling );

# Either store or write this line
    if ($valign_buffer_filling) {
        push @valign_buffer, [@args];
    }
    else {
        valign_output_step_D(@args);
    }

# For lines starting or ending with opening or closing tokens..
    if ($seqno_string) {
        $last_nonblank_seqno_string = $seqno_string;

# Start storing lines when we see a line with multiple stacked opening
        # tokens.
        # patch for RT #94354, requested by Colin Williams
        if ( $seqno_string =~ /^\d+(\:+\d+)+$/ && $args[0] !~ /^[\}\)\]\:\?]/ )
        {

# This test is efficient but a little subtle: The first test says
            # that we have multiple sequence numbers and hence multiple opening
            # or closing tokens in this line.  The second part of the test
            # rejects stacked closing and ternary tokens.  So if we get here
            # then we should have stacked unbalanced opening tokens.

# Here is a complex example:

# Foo($Bar[0], {  # (side comment)
            # 	baz => 1,
            # });

# The first line has sequence 6::4.  It does not begin with
            # a closing token or ternary, so it passes the test and must be
            # stacked opening tokens.

# The last line has sequence 4:6 but is a stack of closing tokens,
            # so it gets rejected.

# Note that the sequence number of an opening token for a qw quote
            # is a negative number and will be rejected.
            # For example, for the following line:
            #    skip_symbols([qw(
            # $seqno_string='10:5:-1'.  It would be okay to accept it but
            # I decided not to do this after testing.

$valign_buffer_filling = $seqno_string;

}
    }
    return;
}

sub valign_output_step_D {

###############################################################
    # This is Step D in writing vertically aligned lines.
    # Write one vertically aligned line of code to the output object.
    ###############################################################

my ( $line, $leading_space_count, $level ) = @_;

# The line is currently correct if there is no tabbing (recommended!)
    # We may have to lop off some leading spaces and replace with tabs.
    if ( $leading_space_count > 0 ) {

# Nothing to do if no tabs
        if ( !( $rOpts_tabs || $rOpts_entab_leading_whitespace )
            || $rOpts_indent_columns <= 0 )
        {

# nothing to do
        }

# Handle entab option
        elsif ($rOpts_entab_leading_whitespace) {

# Patch 12-nov-2018 based on report from Glenn. Extra padding was
         # not correctly entabbed, nor were side comments:
         # Increase leading space count for a padded line to get correct tabbing
            if ( $line =~ /^(\s+)(.*)$/ ) {
                my $spaces = length($1);
                if ( $spaces > $leading_space_count ) {
                    $leading_space_count = $spaces;
                }
            }

my $space_count =
              $leading_space_count % $rOpts_entab_leading_whitespace;
            my $tab_count =
              int( $leading_space_count / $rOpts_entab_leading_whitespace );
            my $leading_string = "\t" x $tab_count . ' ' x $space_count;
            if ( $line =~ /^\s{$leading_space_count,$leading_space_count}/ ) {
                substr( $line, 0, $leading_space_count ) = $leading_string;
            }
            else {

# shouldn't happen - program error counting whitespace
                # - skip entabbing
                VALIGN_DEBUG_FLAG_TABS
                  && warning(
"Error entabbing in valign_output_step_D: expected count=$leading_space_count\n"
                  );
            }
        }

# Handle option of one tab per level
        else {
            my $leading_string = ( "\t" x $level );
            my $space_count =
              $leading_space_count - $level * $rOpts_indent_columns;

# shouldn't happen:
            if ( $space_count < 0 ) {

# But it could be an outdented comment
                if ( $line !~ /^\s*#/ ) {
                    VALIGN_DEBUG_FLAG_TABS
                      && warning(
"Error entabbing in valign_output_step_D: for level=$group_level count=$leading_space_count\n"
                      );
                }
                $leading_string = ( ' ' x $leading_space_count );
            }
            else {
                $leading_string .= ( ' ' x $space_count );
            }
            if ( $line =~ /^\s{$leading_space_count,$leading_space_count}/ ) {
                substr( $line, 0, $leading_space_count ) = $leading_string;
            }
            else {

# shouldn't happen - program error counting whitespace
                # we'll skip entabbing
                VALIGN_DEBUG_FLAG_TABS
                  && warning(
"Error entabbing in valign_output_step_D: expected count=$leading_space_count\n"
                  );
            }
        }
    }
    $file_writer_object->write_code_line( $line . "\n" );
    return;
}

{    # begin get_leading_string

my @leading_string_cache;

sub get_leading_string {

# define the leading whitespace string for this line..
        my $leading_whitespace_count = shift;

# Handle case of zero whitespace, which includes multi-line quotes
        # (which may have a finite level; this prevents tab problems)
        if ( $leading_whitespace_count <= 0 ) {
            return "";
        }

# look for previous result
        elsif ( $leading_string_cache[$leading_whitespace_count] ) {
            return $leading_string_cache[$leading_whitespace_count];
        }

# must compute a string for this number of spaces
        my $leading_string;

# Handle simple case of no tabs
        if ( !( $rOpts_tabs || $rOpts_entab_leading_whitespace )
            || $rOpts_indent_columns <= 0 )
        {
            $leading_string = ( ' ' x $leading_whitespace_count );
        }

# Handle entab option
        elsif ($rOpts_entab_leading_whitespace) {
            my $space_count =
              $leading_whitespace_count % $rOpts_entab_leading_whitespace;
            my $tab_count = int(
                $leading_whitespace_count / $rOpts_entab_leading_whitespace );
            $leading_string = "\t" x $tab_count . ' ' x $space_count;
        }

# Handle option of one tab per level
        else {
            $leading_string = ( "\t" x $group_level );
            my $space_count =
              $leading_whitespace_count - $group_level * $rOpts_indent_columns;

# shouldn't happen:
            if ( $space_count < 0 ) {
                VALIGN_DEBUG_FLAG_TABS
                  && warning(
"Error in get_leading_string: for level=$group_level count=$leading_whitespace_count\n"
                  );

# -- skip entabbing
                $leading_string = ( ' ' x $leading_whitespace_count );
            }
            else {
                $leading_string .= ( ' ' x $space_count );
            }
        }
        $leading_string_cache[$leading_whitespace_count] = $leading_string;
        return $leading_string;
    }
}    # end get_leading_string

sub report_anything_unusual {
    my $self = shift;
    if ( $outdented_line_count > 0 ) {
        write_logfile_entry(
            "$outdented_line_count long lines were outdented:\n");
        write_logfile_entry(
            "  First at output line $first_outdented_line_at\n");

if ( $outdented_line_count > 1 ) {
            write_logfile_entry(
                "   Last at output line $last_outdented_line_at\n");
        }
        write_logfile_entry(
            "  use -noll to prevent outdenting, -l=n to increase line length\n"
        );
        write_logfile_entry("\n");
    }
    return;
}
1;

${this.title}

Code Editor : VerticalAligner.pm