From: Steve Hancock Date: Fri, 22 Nov 2024 00:09:57 +0000 (-0800) Subject: remove needless closure X-Git-Tag: 20240903.07~10 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=e97afa03f60909ab86cf2d1e4838796fa5c3c75e;p=perltidy.git remove needless closure --- diff --git a/lib/Perl/Tidy/VerticalAligner.pm b/lib/Perl/Tidy/VerticalAligner.pm index 15aadff4..f0971602 100644 --- a/lib/Perl/Tidy/VerticalAligner.pm +++ b/lib/Perl/Tidy/VerticalAligner.pm @@ -514,6 +514,10 @@ my %is_opening_token; my %is_closing_token; my %is_digit_char; my %is_plus_or_minus; +my %is_if_or; +my %is_assignment; +my %is_comma_token; +my %is_good_marginal_alignment; BEGIN { @@ -528,6 +532,22 @@ BEGIN { @q = qw( + - ); @is_plus_or_minus{@q} = (1) x scalar(@q); + + @q = qw( if unless or || ); + @is_if_or{@q} = (1) x scalar(@q); + + @q = qw( = **= += *= &= <<= &&= -= /= |= >>= ||= //= .= %= ^= x= ); + @is_assignment{@q} = (1) x scalar(@q); + + @q = qw( => ); + push @q, ','; + @is_comma_token{@q} = (1) x scalar(@q); + + # We can be less restrictive in marginal cases at certain "good" alignments + @q = qw( { ? => = ); + push @q, (','); + @is_good_marginal_alignment{@q} = (1) x scalar(@q); + } #-------------------------------------------- @@ -1083,51 +1103,39 @@ sub join_hanging_comment { return 1; } ## end sub join_hanging_comment -{ ## closure for sub decide_if_list +sub decide_if_list { - my %is_comma_token; + my $line = shift; - BEGIN { - - my @q = qw( => ); - push @q, ','; - @is_comma_token{@q} = (1) x scalar(@q); - } ## end BEGIN - - sub decide_if_list { - - my $line = shift; - - # Given: - # $line = ref to hash of values for a line - # Task: - # Set 'list_type' property - - # 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 #) - - my $rtokens = $line->{'rtokens'}; - my $test_token = $rtokens->[0]; - my ( $raw_tok, $lev, $tag, $tok_count ) = - decode_alignment_token($test_token); - if ( $is_comma_token{$raw_tok} ) { - my $list_type = $test_token; - my $jmax = $line->{'jmax'}; - - foreach ( 1 .. $jmax - 2 ) { - ( $raw_tok, $lev, $tag, $tok_count ) = - decode_alignment_token( $rtokens->[$_] ); - if ( !$is_comma_token{$raw_tok} ) { - $list_type = EMPTY_STRING; - last; - } + # Given: + # $line = ref to hash of values for a line + # Task: + # Set 'list_type' property + + # 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 #) + + my $rtokens = $line->{'rtokens'}; + my $test_token = $rtokens->[0]; + my ( $raw_tok, $lev, $tag, $tok_count ) = + decode_alignment_token($test_token); + if ( $is_comma_token{$raw_tok} ) { + my $list_type = $test_token; + my $jmax = $line->{'jmax'}; + + foreach ( 1 .. $jmax - 2 ) { + ( $raw_tok, $lev, $tag, $tok_count ) = + decode_alignment_token( $rtokens->[$_] ); + if ( !$is_comma_token{$raw_tok} ) { + $list_type = EMPTY_STRING; + last; } - $line->{'list_type'} = $list_type; } - return; - } ## end sub decide_if_list -} + $line->{'list_type'} = $list_type; + } + return; +} ## end sub decide_if_list sub fix_terminal_ternary { @@ -2900,497 +2908,473 @@ EOM } ## end sub decode_alignment_token } -{ ## closure for sub delete_unmatched_tokens +sub delete_unmatched_tokens { + my ( $rlines, $group_level ) = @_; - my %is_assignment; - my %keep_after_deleted_assignment; + # Remove as many obviously un-needed alignment tokens as possible. + # This will prevent them from interfering with the final alignment. - BEGIN { - my @q; + # Given: + # $rlines = ref to hash of all lines in this alignment group + # $group_level = their comment indentation level - @q = qw( = **= += *= &= <<= &&= -= /= |= >>= ||= //= .= %= ^= x= ); - @is_assignment{@q} = (1) x scalar(@q); + # Return: + my $max_lev_diff = 0; # used to avoid a call to prune_tree + my $saw_side_comment = 0; # used to avoid a call for side comments + my $saw_signed_number = 0; # used to avoid a call for -vsn - # These tokens may be kept following an = deletion - @q = qw( if unless or || ); - @keep_after_deleted_assignment{@q} = (1) x scalar(@q); + # Handle no lines -- shouldn't happen + return unless @{$rlines}; - } ## end BEGIN + # Handle a single line + if ( @{$rlines} == 1 ) { + my $line = $rlines->[0]; + my $jmax = $line->{'jmax'}; + my $length = $line->{'rfield_lengths'}->[$jmax]; + $saw_side_comment = $length > 0; + return ( $max_lev_diff, $saw_side_comment, $saw_signed_number ); + } - sub delete_unmatched_tokens { - my ( $rlines, $group_level ) = @_; + # ignore hanging side comments in these operations + my @filtered = grep { !$_->{'is_hanging_side_comment'} } @{$rlines}; + my $rnew_lines = \@filtered; - # Remove as many obviously un-needed alignment tokens as possible. - # This will prevent them from interfering with the final alignment. + $saw_side_comment = @filtered != @{$rlines}; + $max_lev_diff = 0; - # Given: - # $rlines = ref to hash of all lines in this alignment group - # $group_level = their comment indentation level + # nothing to do if all lines were hanging side comments + my $jmax = @{$rnew_lines} - 1; + return ( $max_lev_diff, $saw_side_comment, $saw_signed_number ) + if ( $jmax < 0 ); - # Return: - my $max_lev_diff = 0; # used to avoid a call to prune_tree - my $saw_side_comment = 0; # used to avoid a call for side comments - my $saw_signed_number = 0; # used to avoid a call for -vsn - - # Handle no lines -- shouldn't happen - return unless @{$rlines}; + #---------------------------------------------------- + # Create a hash of alignment token info for each line + #---------------------------------------------------- + ( my $rline_hashes, my $requals_info, $saw_side_comment, $max_lev_diff ) = + make_alignment_info( $group_level, $rnew_lines, $saw_side_comment ); - # Handle a single line - if ( @{$rlines} == 1 ) { - my $line = $rlines->[0]; - my $jmax = $line->{'jmax'}; - my $length = $line->{'rfield_lengths'}->[$jmax]; - $saw_side_comment = $length > 0; - return ( $max_lev_diff, $saw_side_comment, $saw_signed_number ); + #------------------------------------------------------------ + # Find independent subgroups of lines. Neighboring subgroups + # do not have a common alignment token. + #------------------------------------------------------------ + my @subgroups; + push @subgroups, [ 0, $jmax ]; + foreach my $jl ( 0 .. $jmax - 1 ) { + if ( $rnew_lines->[$jl]->{'end_group'} ) { + $subgroups[-1]->[1] = $jl; + push @subgroups, [ $jl + 1, $jmax ]; } + } - # ignore hanging side comments in these operations - my @filtered = grep { !$_->{'is_hanging_side_comment'} } @{$rlines}; - my $rnew_lines = \@filtered; - - $saw_side_comment = @filtered != @{$rlines}; - $max_lev_diff = 0; - - # nothing to do if all lines were hanging side comments - my $jmax = @{$rnew_lines} - 1; - return ( $max_lev_diff, $saw_side_comment, $saw_signed_number ) - if ( $jmax < 0 ); - - #---------------------------------------------------- - # Create a hash of alignment token info for each line - #---------------------------------------------------- - ( my $rline_hashes, my $requals_info, $saw_side_comment, $max_lev_diff ) - = make_alignment_info( $group_level, $rnew_lines, $saw_side_comment ); - - #------------------------------------------------------------ - # Find independent subgroups of lines. Neighboring subgroups - # do not have a common alignment token. - #------------------------------------------------------------ - my @subgroups; - push @subgroups, [ 0, $jmax ]; - foreach my $jl ( 0 .. $jmax - 1 ) { - if ( $rnew_lines->[$jl]->{'end_group'} ) { - $subgroups[-1]->[1] = $jl; - push @subgroups, [ $jl + 1, $jmax ]; - } - } + #----------------------------------------------------------- + # PASS 1 over subgroups to remove unmatched alignment tokens + #----------------------------------------------------------- + delete_unmatched_tokens_main_loop( + $group_level, $rnew_lines, \@subgroups, + $rline_hashes, $requals_info + ); - #----------------------------------------------------------- - # PASS 1 over subgroups to remove unmatched alignment tokens - #----------------------------------------------------------- - delete_unmatched_tokens_main_loop( - $group_level, $rnew_lines, \@subgroups, - $rline_hashes, $requals_info - ); + #---------------------------------------------------------------- + # PASS 2: Construct a tree of matched lines and delete some small + # deeper levels of tokens. They also block good alignments. + #---------------------------------------------------------------- + prune_alignment_tree($rnew_lines) if ($max_lev_diff); - #---------------------------------------------------------------- - # PASS 2: Construct a tree of matched lines and delete some small - # deeper levels of tokens. They also block good alignments. - #---------------------------------------------------------------- - prune_alignment_tree($rnew_lines) if ($max_lev_diff); + #-------------------------------------------- + # PASS 3: compare all lines for common tokens + #-------------------------------------------- + $saw_signed_number = + match_line_pairs( $rlines, $rnew_lines, \@subgroups, $group_level ); - #-------------------------------------------- - # PASS 3: compare all lines for common tokens - #-------------------------------------------- - $saw_signed_number = - match_line_pairs( $rlines, $rnew_lines, \@subgroups, $group_level ); + return ( $max_lev_diff, $saw_side_comment, $saw_signed_number ); +} ## end sub delete_unmatched_tokens - return ( $max_lev_diff, $saw_side_comment, $saw_signed_number ); - } ## end sub delete_unmatched_tokens +sub make_alignment_info { - sub make_alignment_info { + my ( $group_level, $rnew_lines, $saw_side_comment ) = @_; - my ( $group_level, $rnew_lines, $saw_side_comment ) = @_; + # Create a hash of alignment token info for each line + # This info will be used to find common alignments - # Create a hash of alignment token info for each line - # This info will be used to find common alignments + # Given: + # $group_level = common indentation level + # $rnew_lines = ref to hash of line info + # $saw_side_comment = true if there is a side comment + # Return: + # $rline_hashes = ref to hash with new line vars + # \@equals_info = ref to array with info on any '=' tokens + # $saw_side_comment = updated side comment flag + # $max_lev_diff = maximum level change seen - # Given: - # $group_level = common indentation level - # $rnew_lines = ref to hash of line info - # $saw_side_comment = true if there is a side comment - # Return: - # $rline_hashes = ref to hash with new line vars - # \@equals_info = ref to array with info on any '=' tokens - # $saw_side_comment = updated side comment flag - # $max_lev_diff = maximum level change seen - - #---------------- - # Loop over lines - #---------------- - my $rline_hashes = []; - my @equals_info; - my @line_info; # no longer used - my $jmax = @{$rnew_lines} - 1; - my $max_lev_diff = 0; - foreach my $line ( @{$rnew_lines} ) { - my $rhash = {}; - my $rtokens = $line->{'rtokens'}; - my $rpatterns = $line->{'rpatterns'}; - my $i = 0; - my ( $i_eq, $tok_eq, $pat_eq ); - my ( $lev_min, $lev_max ); - foreach my $tok ( @{$rtokens} ) { - my ( $raw_tok, $lev, $tag, $tok_count ) = - decode_alignment_token($tok); + #---------------- + # Loop over lines + #---------------- + my $rline_hashes = []; + my @equals_info; + my @line_info; # no longer used + my $jmax = @{$rnew_lines} - 1; + my $max_lev_diff = 0; + foreach my $line ( @{$rnew_lines} ) { + my $rhash = {}; + my $rtokens = $line->{'rtokens'}; + my $rpatterns = $line->{'rpatterns'}; + my $i = 0; + my ( $i_eq, $tok_eq, $pat_eq ); + my ( $lev_min, $lev_max ); + foreach my $tok ( @{$rtokens} ) { + my ( $raw_tok, $lev, $tag, $tok_count ) = + decode_alignment_token($tok); - if ( $tok ne '#' ) { - if ( !defined($lev_min) ) { - $lev_min = $lev; - $lev_max = $lev; - } - else { - if ( $lev < $lev_min ) { $lev_min = $lev } - if ( $lev > $lev_max ) { $lev_max = $lev } - } + if ( $tok ne '#' ) { + if ( !defined($lev_min) ) { + $lev_min = $lev; + $lev_max = $lev; } else { - if ( !$saw_side_comment ) { - my $length = $line->{'rfield_lengths'}->[ $i + 1 ]; - $saw_side_comment ||= $length; - } + if ( $lev < $lev_min ) { $lev_min = $lev } + if ( $lev > $lev_max ) { $lev_max = $lev } } + } + else { + if ( !$saw_side_comment ) { + my $length = $line->{'rfield_lengths'}->[ $i + 1 ]; + $saw_side_comment ||= $length; + } + } - # Possible future upgrade: for multiple matches, - # record [$i1, $i2, ..] instead of $i - $rhash->{$tok} = - [ $i, undef, undef, $raw_tok, $lev, $tag, $tok_count ]; + # 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 '=' ) { + # remember the first equals at line level + if ( !defined($i_eq) && $raw_tok eq '=' ) { - if ( $lev eq $group_level ) { - $i_eq = $i; - $tok_eq = $tok; - $pat_eq = $rpatterns->[$i]; - } + if ( $lev eq $group_level ) { + $i_eq = $i; + $tok_eq = $tok; + $pat_eq = $rpatterns->[$i]; } - $i++; - } - push @{$rline_hashes}, $rhash; - push @equals_info, [ $i_eq, $tok_eq, $pat_eq ]; - push @line_info, [ $lev_min, $lev_max ]; - if ( defined($lev_min) ) { - my $lev_diff = $lev_max - $lev_min; - if ( $lev_diff > $max_lev_diff ) { $max_lev_diff = $lev_diff } } + $i++; + } + push @{$rline_hashes}, $rhash; + push @equals_info, [ $i_eq, $tok_eq, $pat_eq ]; + push @line_info, [ $lev_min, $lev_max ]; + if ( defined($lev_min) ) { + my $lev_diff = $lev_max - $lev_min; + if ( $lev_diff > $max_lev_diff ) { $max_lev_diff = $lev_diff } } + } - #---------------------------------------------------- - # Loop to compare each line pair and remember matches - #---------------------------------------------------- - my $rtok_hash = {}; - my $nr = 0; - foreach my $jl ( 0 .. $jmax - 1 ) { - my $nl = $nr; - $nr = 0; - my $jr = $jl + 1; - my $rhash_l = $rline_hashes->[$jl]; - my $rhash_r = $rline_hashes->[$jr]; - foreach my $tok ( keys %{$rhash_l} ) { - if ( defined( $rhash_r->{$tok} ) ) { - 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++; - } + #---------------------------------------------------- + # Loop to compare each line pair and remember matches + #---------------------------------------------------- + my $rtok_hash = {}; + my $nr = 0; + foreach my $jl ( 0 .. $jmax - 1 ) { + my $nl = $nr; + $nr = 0; + my $jr = $jl + 1; + my $rhash_l = $rline_hashes->[$jl]; + my $rhash_r = $rline_hashes->[$jr]; + foreach my $tok ( keys %{$rhash_l} ) { + if ( defined( $rhash_r->{$tok} ) ) { + 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 - # (this is not strictly necessary now but does not hurt) - if ( $nr == 0 && $nl > 0 ) { + # Set a line break if no matching tokens between these lines + # (this is not strictly necessary now but does not hurt) + if ( $nr == 0 && $nl > 0 ) { + $rnew_lines->[$jl]->{'end_group'} = 1; + } + + # Also set a line break if both lines have simple equals but with + # different leading characters in patterns. This check is similar + # to one in sub check_match, and will prevent sub + # prune_alignment_tree from removing alignments which otherwise + # should be kept. This fix is rarely needed, but it can + # occasionally improve formatting. + # For example: + # my $name = $this->{Name}; + # $type = $this->ctype($genlooptype) if defined $genlooptype; + # my $declini = ( $asgnonly ? "" : "\t$type *" ); + # my $cast = ( $type ? "($type *)" : "" ); + # The last two lines start with 'my' and will not match the + # previous line starting with $type, so we do not want + # prune_alignment tree to delete their ? : alignments at a deeper + # level. + my ( $i_eq_l, $tok_eq_l, $pat_eq_l ) = @{ $equals_info[$jl] }; + my ( $i_eq_r, $tok_eq_r, $pat_eq_r ) = @{ $equals_info[$jr] }; + if ( defined($i_eq_l) && defined($i_eq_r) ) { + + # Also, do not align equals across a change in ci level + my $ci_jump = $rnew_lines->[$jl]->{'ci_level'} != + $rnew_lines->[$jr]->{'ci_level'}; + + if ( + $tok_eq_l eq $tok_eq_r + && $i_eq_l == 0 + && $i_eq_r == 0 + && ( substr( $pat_eq_l, 0, 1 ) ne substr( $pat_eq_r, 0, 1 ) + || $ci_jump ) + ) + { $rnew_lines->[$jl]->{'end_group'} = 1; } + } + } + return ( $rline_hashes, \@equals_info, $saw_side_comment, $max_lev_diff ); +} ## end sub make_alignment_info - # Also set a line break if both lines have simple equals but with - # different leading characters in patterns. This check is similar - # to one in sub check_match, and will prevent sub - # prune_alignment_tree from removing alignments which otherwise - # should be kept. This fix is rarely needed, but it can - # occasionally improve formatting. - # For example: - # my $name = $this->{Name}; - # $type = $this->ctype($genlooptype) if defined $genlooptype; - # my $declini = ( $asgnonly ? "" : "\t$type *" ); - # my $cast = ( $type ? "($type *)" : "" ); - # The last two lines start with 'my' and will not match the - # previous line starting with $type, so we do not want - # prune_alignment tree to delete their ? : alignments at a deeper - # level. - my ( $i_eq_l, $tok_eq_l, $pat_eq_l ) = @{ $equals_info[$jl] }; - my ( $i_eq_r, $tok_eq_r, $pat_eq_r ) = @{ $equals_info[$jr] }; - if ( defined($i_eq_l) && defined($i_eq_r) ) { - - # Also, do not align equals across a change in ci level - my $ci_jump = $rnew_lines->[$jl]->{'ci_level'} != - $rnew_lines->[$jr]->{'ci_level'}; +sub delete_unmatched_tokens_main_loop { - if ( - $tok_eq_l eq $tok_eq_r - && $i_eq_l == 0 - && $i_eq_r == 0 - && ( substr( $pat_eq_l, 0, 1 ) ne substr( $pat_eq_r, 0, 1 ) - || $ci_jump ) - ) - { - $rnew_lines->[$jl]->{'end_group'} = 1; - } - } - } - return ( $rline_hashes, \@equals_info, $saw_side_comment, - $max_lev_diff ); - } ## end sub make_alignment_info + my ( $group_level, $rnew_lines, $rsubgroups, $rline_hashes, $requals_info ) + = @_; - sub delete_unmatched_tokens_main_loop { + #-------------------------------------------------------------- + # Main loop over subgroups to remove unmatched alignment tokens + #-------------------------------------------------------------- - my ( - $group_level, $rnew_lines, $rsubgroups, - $rline_hashes, $requals_info - ) = @_; + # flag to allow skipping pass 2 - not currently used + my $saw_large_group; - #-------------------------------------------------------------- - # Main loop over subgroups to remove unmatched alignment tokens - #-------------------------------------------------------------- - - # flag to allow skipping pass 2 - not currently used - my $saw_large_group; - - my $has_terminal_match = $rnew_lines->[-1]->{'j_terminal_match'}; - - foreach my $item ( @{$rsubgroups} ) { - my ( $jbeg, $jend ) = @{$item}; - - my $nlines = $jend - $jbeg + 1; - - #--------------------------------------------------- - # Look for complete if/elsif/else and ternary blocks - #--------------------------------------------------- - - # We are looking for a common '$dividing_token' like these: - - # if ( $b and $s ) { $p->{'type'} = 'a'; } - # elsif ($b) { $p->{'type'} = 'b'; } - # elsif ($s) { $p->{'type'} = 's'; } - # else { $p->{'type'} = ''; } - # ^----------- dividing_token - - # my $severity = - # !$routine ? '[PFX]' - # : $routine =~ /warn.*_d\z/ ? '[DS]' - # : $routine =~ /ck_warn/ ? 'W' - # : $routine =~ /ckWARN\d*reg_d/ ? 'S' - # : $routine =~ /ckWARN\d*reg/ ? 'W' - # : $routine =~ /vWARN\d/ ? '[WDS]' - # : '[PFX]'; - # ^----------- dividing_token - - # Only look for groups which are more than 2 lines long. Two lines - # can get messed up doing this, probably due to the various - # two-line rules. - - my $dividing_token; - my %token_line_count; - if ( $nlines > 2 ) { - - foreach my $jj ( $jbeg .. $jend ) { - my %seen; - my $line = $rnew_lines->[$jj]; - my $rtokens = $line->{'rtokens'}; - foreach my $tok ( @{$rtokens} ) { - if ( !$seen{$tok} ) { - $seen{$tok}++; - $token_line_count{$tok}++; - } + my $has_terminal_match = $rnew_lines->[-1]->{'j_terminal_match'}; + + foreach my $item ( @{$rsubgroups} ) { + my ( $jbeg, $jend ) = @{$item}; + + my $nlines = $jend - $jbeg + 1; + + #--------------------------------------------------- + # Look for complete if/elsif/else and ternary blocks + #--------------------------------------------------- + + # We are looking for a common '$dividing_token' like these: + + # if ( $b and $s ) { $p->{'type'} = 'a'; } + # elsif ($b) { $p->{'type'} = 'b'; } + # elsif ($s) { $p->{'type'} = 's'; } + # else { $p->{'type'} = ''; } + # ^----------- dividing_token + + # my $severity = + # !$routine ? '[PFX]' + # : $routine =~ /warn.*_d\z/ ? '[DS]' + # : $routine =~ /ck_warn/ ? 'W' + # : $routine =~ /ckWARN\d*reg_d/ ? 'S' + # : $routine =~ /ckWARN\d*reg/ ? 'W' + # : $routine =~ /vWARN\d/ ? '[WDS]' + # : '[PFX]'; + # ^----------- dividing_token + + # Only look for groups which are more than 2 lines long. Two lines + # can get messed up doing this, probably due to the various + # two-line rules. + + my $dividing_token; + my %token_line_count; + if ( $nlines > 2 ) { + + foreach my $jj ( $jbeg .. $jend ) { + my %seen; + my $line = $rnew_lines->[$jj]; + my $rtokens = $line->{'rtokens'}; + foreach my $tok ( @{$rtokens} ) { + if ( !$seen{$tok} ) { + $seen{$tok}++; + $token_line_count{$tok}++; } } + } - foreach my $tok ( keys %token_line_count ) { - if ( $token_line_count{$tok} == $nlines ) { - if ( substr( $tok, 0, 1 ) eq '?' - || substr( $tok, 0, 1 ) eq '{' - && $tok =~ /^\{\d+if/ ) - { - $dividing_token = $tok; - last; - } + foreach my $tok ( keys %token_line_count ) { + if ( $token_line_count{$tok} == $nlines ) { + if ( substr( $tok, 0, 1 ) eq '?' + || substr( $tok, 0, 1 ) eq '{' && $tok =~ /^\{\d+if/ ) + { + $dividing_token = $tok; + last; } } } + } - #------------------------------------------------------------- - # Loop over subgroup lines to remove unwanted alignment tokens - #------------------------------------------------------------- - foreach my $jj ( $jbeg .. $jend ) { - my $line = $rnew_lines->[$jj]; - my $rtokens = $line->{'rtokens'}; - my $rhash = $rline_hashes->[$jj]; - my $i_eq = $requals_info->[$jj]->[0]; - my @idel; - my $imax = @{$rtokens} - 2; - my $delete_above_level; - my $deleted_assignment_token; - - my $saw_dividing_token = EMPTY_STRING; - $saw_large_group ||= $nlines > 2 && $imax > 1; - - # Loop over all alignment tokens - foreach my $i ( 0 .. $imax ) { - my $tok = $rtokens->[$i]; - next if ( $tok eq '#' ); # shouldn't happen - my ( $iii_uu, $il, $ir, $raw_tok, $lev, $tag_uu, - $tok_count ) - = @{ $rhash->{$tok} }; - - #------------------------------------------------------ - # Here is the basic RULE: remove an unmatched alignment - # which does not occur in the surrounding lines. - #------------------------------------------------------ - my $delete_me = !defined($il) && !defined($ir); - - # Apply any user controls. Note that not all lines pass - # this way so they have to be applied elsewhere too. - my $align_ok = 1; - if (%valign_control_hash) { - $align_ok = $valign_control_hash{$raw_tok}; - $align_ok = $valign_control_default - unless defined($align_ok); - $delete_me ||= !$align_ok; - } + #------------------------------------------------------------- + # Loop over subgroup lines to remove unwanted alignment tokens + #------------------------------------------------------------- + foreach my $jj ( $jbeg .. $jend ) { + my $line = $rnew_lines->[$jj]; + my $rtokens = $line->{'rtokens'}; + my $rhash = $rline_hashes->[$jj]; + my $i_eq = $requals_info->[$jj]->[0]; + my @idel; + my $imax = @{$rtokens} - 2; + my $delete_above_level; + my $deleted_assignment_token; - # But now we modify this with exceptions... + my $saw_dividing_token = EMPTY_STRING; + $saw_large_group ||= $nlines > 2 && $imax > 1; - # EXCEPTION 1: If we are in a complete ternary or - # if/elsif/else group, and this token is not on every line - # of the group, should we delete it to preserve overall - # alignment? - if ($dividing_token) { - if ( $token_line_count{$tok} >= $nlines ) { - $saw_dividing_token ||= $tok eq $dividing_token; - } - else { + # Loop over all alignment tokens + foreach my $i ( 0 .. $imax ) { + my $tok = $rtokens->[$i]; + next if ( $tok eq '#' ); # shouldn't happen + my ( $iii_uu, $il, $ir, $raw_tok, $lev, $tag_uu, $tok_count ) = + @{ $rhash->{$tok} }; + + #------------------------------------------------------ + # Here is the basic RULE: remove an unmatched alignment + # which does not occur in the surrounding lines. + #------------------------------------------------------ + my $delete_me = !defined($il) && !defined($ir); + + # Apply any user controls. Note that not all lines pass + # this way so they have to be applied elsewhere too. + my $align_ok = 1; + if (%valign_control_hash) { + $align_ok = $valign_control_hash{$raw_tok}; + $align_ok = $valign_control_default + unless defined($align_ok); + $delete_me ||= !$align_ok; + } - # For shorter runs, delete toks to save alignment. - # For longer runs, keep toks after the '{' or '?' - # to allow sub-alignments within braces. The - # number 5 lines is arbitrary but seems to work ok. - $delete_me ||= - ( $nlines < 5 || !$saw_dividing_token ); - } + # But now we modify this with exceptions... + + # EXCEPTION 1: If we are in a complete ternary or + # if/elsif/else group, and this token is not on every line + # of the group, should we delete it to preserve overall + # alignment? + if ($dividing_token) { + if ( $token_line_count{$tok} >= $nlines ) { + $saw_dividing_token ||= $tok eq $dividing_token; } + else { - # EXCEPTION 2: 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; - } - else { $delete_above_level = undef } + # For shorter runs, delete toks to save alignment. + # For longer runs, keep toks after the '{' or '?' + # to allow sub-alignments within braces. The + # number 5 lines is arbitrary but seems to work ok. + $delete_me ||= ( $nlines < 5 || !$saw_dividing_token ); } + } - # EXCEPTION 3: Remove all but certain tokens after an - # assignment deletion. - if ( - $deleted_assignment_token - && ( $lev > $group_level - || !$keep_after_deleted_assignment{$raw_tok} ) - ) - { + # EXCEPTION 2: 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; } + else { $delete_above_level = undef } + } - # EXCEPTION 4: Do not touch the first line of a 2 line - # terminal match, such as below, because j_terminal has - # already been set. - # if ($tag) { $tago = "<$tag>"; $tagc = ""; } - # else { $tago = $tagc = ''; } - # But see snippets 'else1.t' and 'else2.t' - $delete_me = 0 - if ( $jj == $jbeg - && $has_terminal_match - && $nlines == 2 ); + # EXCEPTION 3: Remove all but certain tokens after an + # assignment deletion. + if ( + $deleted_assignment_token + && ( $lev > $group_level + || !$is_if_or{$raw_tok} ) + ) + { + $delete_me ||= 1; + } - # EXCEPTION 5: misc additional rules for commas and equals - if ( $delete_me && $tok_count == 1 ) { + # EXCEPTION 4: Do not touch the first line of a 2 line + # terminal match, such as below, because j_terminal has + # already been set. + # if ($tag) { $tago = "<$tag>"; $tagc = ""; } + # else { $tago = $tagc = ''; } + # But see snippets 'else1.t' and 'else2.t' + $delete_me = 0 + if ( $jj == $jbeg + && $has_terminal_match + && $nlines == 2 ); - # okay to delete second and higher copies of a token + # EXCEPTION 5: misc additional rules for commas and equals + if ( $delete_me && $tok_count == 1 ) { - # for a comma... - if ( $raw_tok eq ',' ) { + # okay to delete second and higher copies of a token - # Do not delete commas before an equals - $delete_me = 0 - if ( defined($i_eq) && $i < $i_eq ); + # for a comma... + if ( $raw_tok eq ',' ) { - # Do not delete line-level commas - $delete_me = 0 if ( $lev <= $group_level ); - } + # Do not delete commas before an equals + $delete_me = 0 + if ( defined($i_eq) && $i < $i_eq ); - # For an assignment at group level.. - if ( $is_assignment{$raw_tok} - && $lev == $group_level ) - { + # Do not delete line-level commas + $delete_me = 0 if ( $lev <= $group_level ); + } - # Do not delete if it is the last alignment of - # multiple tokens; this will prevent some - # undesirable alignments - if ( $imax > 0 && $i == $imax ) { - $delete_me = 0; - } + # For an assignment at group level.. + if ( $is_assignment{$raw_tok} + && $lev == $group_level ) + { - # Otherwise, set a flag to delete most - # remaining tokens - else { $deleted_assignment_token = $raw_tok } + # Do not delete if it is the last alignment of + # multiple tokens; this will prevent some + # undesirable alignments + if ( $imax > 0 && $i == $imax ) { + $delete_me = 0; } + + # Otherwise, set a flag to delete most + # remaining tokens + else { $deleted_assignment_token = $raw_tok } } + } - # Do not let a user exclusion be reactivated by above rules - $delete_me ||= !$align_ok; + # Do not let a user exclusion be reactivated by above rules + $delete_me ||= !$align_ok; - #------------------------------------ - # Add this token to the deletion list - #------------------------------------ - if ($delete_me) { - push @idel, $i; + #------------------------------------ + # Add this token to the deletion list + #------------------------------------ + if ($delete_me) { + push @idel, $i; - # update deletion propagation flags - if ( !defined($delete_above_level) - || $lev < $delete_above_level ) - { + # update deletion propagation flags + if ( !defined($delete_above_level) + || $lev < $delete_above_level ) + { - # delete all following higher level alignments - $delete_above_level = $lev; + # 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; - } + # but keep deleting after => to next lower level + # to avoid some bizarre alignments + if ( $raw_tok eq '=>' ) { + $delete_above_level = $lev - 1; } } - } # End loop over alignment tokens - - # Process all deletion requests for this line - if (@idel) { - delete_selected_tokens( $line, \@idel ); } - } # End loop over lines - } ## end main loop over subgroups + } # End loop over alignment tokens - return; - } ## end sub delete_unmatched_tokens_main_loop -} + # Process all deletion requests for this line + if (@idel) { + delete_selected_tokens( $line, \@idel ); + } + } # End loop over lines + } ## end main loop over subgroups + + return; +} ## end sub delete_unmatched_tokens_main_loop sub match_line_pairs { my ( $rlines, $rnew_lines, $rsubgroups, $group_level ) = @_; @@ -4269,362 +4253,342 @@ sub Dump_tree_groups { return; } ## end sub Dump_tree_groups -{ ## closure for sub is_marginal_match - - my %is_if_or; - my %is_assignment; - my %is_good_alignment; - - # This test did not give sufficiently better results to use as an update, - # but the flag is worth keeping as a starting point for future testing. - use constant TEST_MARGINAL_EQ_ALIGNMENT => 0; +# This test did not give sufficiently better results to use as an update, +# but the flag is kept as a starting point for future testing. +use constant TEST_MARGINAL_EQ_ALIGNMENT => 0; - 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); - - # Vertically aligning on certain "good" tokens is usually okay - # so we can be less restrictive in marginal cases. - @q = qw( { ? => = ); - push @q, (','); - @is_good_alignment{@q} = (1) x scalar(@q); - } ## end BEGIN +sub is_marginal_match { - sub is_marginal_match { + my ( $line_0, $line_1, $group_level, $imax_align, $imax_prev ) = @_; - my ( $line_0, $line_1, $group_level, $imax_align, $imax_prev ) = @_; + # Decide if we should undo some or all of the common alignments of a + # group of just two lines. - # Decide if we should undo some or all of the common alignments of a - # group of just two lines. + # Given: + # $line_0 and $line_1 - the two lines + # $group_level = the indentation level of the group being processed + # $imax_align = the maximum index of the common alignment tokens + # of the two lines + # $imax_prev = the maximum index of the common alignment tokens + # with the line before $line_0 (=-1 of does not exist) - # Given: - # $line_0 and $line_1 - the two lines - # $group_level = the indentation level of the group being processed - # $imax_align = the maximum index of the common alignment tokens - # of the two lines - # $imax_prev = the maximum index of the common alignment tokens - # with the line before $line_0 (=-1 of does not exist) + # Return: + # $is_marginal = true if the two lines should NOT be fully aligned + # = false if the two lines can remain fully aligned + # $imax_align = the index of the highest alignment token shared by + # these two lines to keep if the match is marginal. - # Return: - # $is_marginal = true if the two lines should NOT be fully aligned - # = false if the two lines can remain fully aligned - # $imax_align = the index of the highest alignment token shared by - # these two lines to keep if the match is marginal. + # When we have an alignment group of just two lines like this, we are + # working in the twilight zone of what looks good and what looks bad. + # This routine is a collection of rules which work have been found to + # work fairly well, but it will need to be updated from time to time. - # When we have an alignment group of just two lines like this, we are - # working in the twilight zone of what looks good and what looks bad. - # This routine is a collection of rules which work have been found to - # work fairly well, but it will need to be updated from time to time. + my $is_marginal = 0; - my $is_marginal = 0; + #--------------------------------------- + # Always align certain special cases ... + #--------------------------------------- + if ( - #--------------------------------------- - # Always align certain special cases ... - #--------------------------------------- - if ( + # always keep alignments of a terminal else or ternary + defined( $line_1->{'j_terminal_match'} ) - # always keep alignments of a terminal else or ternary - defined( $line_1->{'j_terminal_match'} ) + # always align lists + || $line_0->{'list_type'} - # always align lists - || $line_0->{'list_type'} + # always align hanging side comments + || $line_1->{'is_hanging_side_comment'} - # always align hanging side comments - || $line_1->{'is_hanging_side_comment'} + ) + { + return ( $is_marginal, $imax_align ); + } - ) - { - return ( $is_marginal, $imax_align ); - } - - my $jmax_0 = $line_0->{'jmax'}; - my $jmax_1 = $line_1->{'jmax'}; - my $rtokens_1 = $line_1->{'rtokens'}; -## my $rtokens_0 = $line_0->{'rtokens'}; - my $rfield_lengths_0 = $line_0->{'rfield_lengths'}; - my $rfield_lengths_1 = $line_1->{'rfield_lengths'}; - my $rpatterns_0 = $line_0->{'rpatterns'}; - my $rpatterns_1 = $line_1->{'rpatterns'}; - my $imax_next = $line_1->{'imax_pair'}; - - # We will scan the alignment tokens and set a flag '$is_marginal' if - # it seems that the an alignment would look bad. - my $max_pad = 0; - my $saw_good_alignment = 0; - my $saw_if_or; # if we saw an 'if' or 'or' at group level - my $raw_tokb = EMPTY_STRING; # first token seen at group level - my $jfirst_bad; - my $line_ending_fat_comma; # is last token just a '=>' ? - my $j0_eq_pad; - my $j0_max_pad = 0; - - foreach my $j ( 0 .. $jmax_1 - 2 ) { - my ( $raw_tok, $lev, $tag_uu, $tok_count_uu ) = - decode_alignment_token( $rtokens_1->[$j] ); - if ( $raw_tok && $lev == $group_level ) { - if ( !$raw_tokb ) { $raw_tokb = $raw_tok } - $saw_if_or ||= $is_if_or{$raw_tok}; - } + my $jmax_0 = $line_0->{'jmax'}; + my $jmax_1 = $line_1->{'jmax'}; + my $rtokens_1 = $line_1->{'rtokens'}; +## my $rtokens_0 = $line_0->{'rtokens'}; + my $rfield_lengths_0 = $line_0->{'rfield_lengths'}; + my $rfield_lengths_1 = $line_1->{'rfield_lengths'}; + my $rpatterns_0 = $line_0->{'rpatterns'}; + my $rpatterns_1 = $line_1->{'rpatterns'}; + my $imax_next = $line_1->{'imax_pair'}; + + # We will scan the alignment tokens and set a flag '$is_marginal' if + # it seems that the an alignment would look bad. + my $max_pad = 0; + my $saw_good_alignment = 0; + my $saw_if_or; # if we saw an 'if' or 'or' at group level + my $raw_tokb = EMPTY_STRING; # first token seen at group level + my $jfirst_bad; + my $line_ending_fat_comma; # is last token just a '=>' ? + my $j0_eq_pad; + my $j0_max_pad = 0; + + foreach my $j ( 0 .. $jmax_1 - 2 ) { + my ( $raw_tok, $lev, $tag_uu, $tok_count_uu ) = + decode_alignment_token( $rtokens_1->[$j] ); + if ( $raw_tok && $lev == $group_level ) { + if ( !$raw_tokb ) { $raw_tokb = $raw_tok } + $saw_if_or ||= $is_if_or{$raw_tok}; + } - # When the first of the two lines ends in a bare '=>' this will - # probably be marginal match. (For a bare =>, the next field length - # will be 2 or 3, depending on side comment) - $line_ending_fat_comma = - $j == $jmax_1 - 2 - && $raw_tok eq '=>' - && $rfield_lengths_0->[ $j + 1 ] <= 3; - - my $pad = $rfield_lengths_1->[$j] - $rfield_lengths_0->[$j]; - if ( $j == 0 ) { - $pad += $line_1->{'leading_space_count'} - - $line_0->{'leading_space_count'}; - - # Remember the pad at a leading equals - if ( $raw_tok eq '=' && $lev == $group_level ) { - $j0_eq_pad = $pad; - $j0_max_pad = - 0.5 * ( $rfield_lengths_1->[0] + $rfield_lengths_0->[0] ); - $j0_max_pad = 4 if ( $j0_max_pad < 4 ); - } - } + # When the first of the two lines ends in a bare '=>' this will + # probably be marginal match. (For a bare =>, the next field length + # will be 2 or 3, depending on side comment) + $line_ending_fat_comma = + $j == $jmax_1 - 2 + && $raw_tok eq '=>' + && $rfield_lengths_0->[ $j + 1 ] <= 3; - if ( $pad < 0 ) { $pad = -$pad } - if ( $pad > $max_pad ) { $max_pad = $pad } - if ( $is_good_alignment{$raw_tok} && !$line_ending_fat_comma ) { - $saw_good_alignment = 1; - } - else { - $jfirst_bad = $j unless defined($jfirst_bad); - } - my $pat_0 = $rpatterns_0->[$j]; - my $pat_1 = $rpatterns_1->[$j]; - if ( $pat_0 ne $pat_1 && length($pat_0) eq length($pat_1) ) { - $pat_0 =~ tr/n/Q/; - $pat_1 =~ tr/n/Q/; - } - if ( $pat_0 ne $pat_1 ) { - - # Flag this as a marginal match since patterns differ. - # Normally, we will not allow just two lines to match if - # marginal. But we can allow matching in some specific cases. - - $jfirst_bad = $j if ( !defined($jfirst_bad) ); - $is_marginal = 1 if ( $is_marginal == 0 ); - if ( $raw_tok eq '=' ) { - - # 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. - $is_marginal = 2; - } + my $pad = $rfield_lengths_1->[$j] - $rfield_lengths_0->[$j]; + if ( $j == 0 ) { + $pad += $line_1->{'leading_space_count'} - + $line_0->{'leading_space_count'}; + + # Remember the pad at a leading equals + if ( $raw_tok eq '=' && $lev == $group_level ) { + $j0_eq_pad = $pad; + $j0_max_pad = + 0.5 * ( $rfield_lengths_1->[0] + $rfield_lengths_0->[0] ); + $j0_max_pad = 4 if ( $j0_max_pad < 4 ); } } - $is_marginal = 1 if ( $is_marginal == 0 && $line_ending_fat_comma ); - - # 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 ( $is_marginal == 1 - && ( $saw_good_alignment || $max_pad < 3 ) ) + if ( $pad < 0 ) { $pad = -$pad } + if ( $pad > $max_pad ) { $max_pad = $pad } + if ( $is_good_marginal_alignment{$raw_tok} + && !$line_ending_fat_comma ) { - $is_marginal = 0; - } - - # We will use the line endings to help decide on alignments... - # See if the lines end with semicolons... - my $sc_term0; - my $sc_term1; - if ( $jmax_0 < 1 || $jmax_1 < 1 ) { - - # shouldn't happen + $saw_good_alignment = 1; } else { - my $pat0 = $rpatterns_0->[ $jmax_0 - 1 ]; - my $pat1 = $rpatterns_1->[ $jmax_1 - 1 ]; - $sc_term0 = $pat0 =~ /;b?$/; - $sc_term1 = $pat1 =~ /;b?$/; + $jfirst_bad = $j unless defined($jfirst_bad); + } + my $pat_0 = $rpatterns_0->[$j]; + my $pat_1 = $rpatterns_1->[$j]; + if ( $pat_0 ne $pat_1 && length($pat_0) eq length($pat_1) ) { + $pat_0 =~ tr/n/Q/; + $pat_1 =~ tr/n/Q/; + } + if ( $pat_0 ne $pat_1 ) { + + # Flag this as a marginal match since patterns differ. + # Normally, we will not allow just two lines to match if + # marginal. But we can allow matching in some specific cases. + + $jfirst_bad = $j if ( !defined($jfirst_bad) ); + $is_marginal = 1 if ( $is_marginal == 0 ); + if ( $raw_tok eq '=' ) { + + # 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. + $is_marginal = 2; + } } + } - if ( !$is_marginal && !$sc_term0 ) { + $is_marginal = 1 if ( $is_marginal == 0 && $line_ending_fat_comma ); + + # 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 ( $is_marginal == 1 + && ( $saw_good_alignment || $max_pad < 3 ) ) + { + $is_marginal = 0; + } - # 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; - } - } + # We will use the line endings to help decide on alignments... + # See if the lines end with semicolons... + my $sc_term0; + my $sc_term1; + if ( $jmax_0 < 1 || $jmax_1 < 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 '{' ) - && $jmax_1 == 2 - && $sc_term0 ne $sc_term1; - - #--------------------------------------- - # return if this is not a marginal match - #--------------------------------------- - if ( !$is_marginal ) { - return ( $is_marginal, $imax_align ); - } - - # Undo the marginal match flag in certain cases, - - # 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'} .= "[0]; - my $pat1 = $rpatterns_1->[0]; + # shouldn't happen + } + else { + my $pat0 = $rpatterns_0->[ $jmax_0 - 1 ]; + my $pat1 = $rpatterns_1->[ $jmax_1 - 1 ]; + $sc_term0 = $pat0 =~ /;b?$/; + $sc_term1 = $pat1 =~ /;b?$/; + } - #--------------------------------------------------------- - # Turn off the marginal flag for some types of assignments - #--------------------------------------------------------- - if ( $is_assignment{$raw_tokb} ) { + if ( !$is_marginal && !$sc_term0 ) { - # undo marginal flag if first line is semicolon terminated - # and leading patters match - if ($sc_term0) { # && $sc_term1) { - $is_marginal = $pat0 ne $pat1; - } + # 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; } - elsif ( $raw_tokb eq '=>' ) { + } - # undo marginal flag if patterns match - $is_marginal = $pat0 ne $pat1 || $line_ending_fat_comma; - } - elsif ( $raw_tokb eq '=~' ) { + # 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 '{' ) + && $jmax_1 == 2 + && $sc_term0 ne $sc_term1; + + #--------------------------------------- + # return if this is not a marginal match + #--------------------------------------- + if ( !$is_marginal ) { + return ( $is_marginal, $imax_align ); + } - # undo marginal flag if both lines are semicolon terminated - # and leading patters match - if ( $sc_term1 && $sc_term0 ) { - $is_marginal = $pat0 ne $pat1; - } + # Undo the marginal match flag in certain cases, + + # 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'} .= "[0]; + my $pat1 = $rpatterns_1->[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; } - else { - ##ok: (none of the above) + } + elsif ( $raw_tokb eq '=>' ) { + + # undo marginal flag if patterns match + $is_marginal = $pat0 ne $pat1 || $line_ending_fat_comma; + } + 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; } + } + else { + ##ok: (none of the above) + } - #----------------------------------------------------- - # Turn off the marginal flag if we saw an 'if' or 'or' - #----------------------------------------------------- + #----------------------------------------------------- + # 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*)$/; + # 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] ); + # 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) { + if ($saw_if_or) { - # undo marginal flag if both lines are semicolon terminated - if ( $sc_term0 && $sc_term1 ) { - $is_marginal = 0; - } + # undo marginal flag if both lines are semicolon terminated + if ( $sc_term0 && $sc_term1 ) { + $is_marginal = 0; } + } - # For a marginal match, only keep matches before the first 'bad' match - if ( $is_marginal - && defined($jfirst_bad) - && $imax_align > $jfirst_bad - 1 ) - { - $imax_align = $jfirst_bad - 1; - } + # For a marginal match, only keep matches before the first 'bad' match + if ( $is_marginal + && defined($jfirst_bad) + && $imax_align > $jfirst_bad - 1 ) + { + $imax_align = $jfirst_bad - 1; + } + + #---------------------------------------------------------- + # Allow sweep to match lines with leading '=' in some cases + #---------------------------------------------------------- + if ( $imax_align < 0 && defined($j0_eq_pad) ) { - #---------------------------------------------------------- - # Allow sweep to match lines with leading '=' in some cases - #---------------------------------------------------------- - if ( $imax_align < 0 && defined($j0_eq_pad) ) { + if ( - if ( + # If there is a following line with leading equals, or + # preceding line with leading equals, then let the sweep align + # them without restriction. For example, the first two lines + # here are a marginal match, but they are followed by a line + # with leading equals, so the sweep-lr logic can align all of + # the lines: - # If there is a following line with leading equals, or - # preceding line with leading equals, then let the sweep align - # them without restriction. For example, the first two lines - # here are a marginal match, but they are followed by a line - # with leading equals, so the sweep-lr logic can align all of - # the lines: - - # $date[1] = $month_to_num{ $date[1] }; # <--line_0 - # @xdate = split( /[:\/\s]/, $log->field('t') ); # <--line_1 - # $day = sprintf( "%04d/%02d/%02d", @date[ 2, 1, 0 ] ); - # $time = sprintf( "%02d:%02d:%02d", @date[ 3 .. 5 ] ); - - # Likewise, if we reverse the two pairs we want the same result - - # $day = sprintf( "%04d/%02d/%02d", @date[ 2, 1, 0 ] ); - # $time = sprintf( "%02d:%02d:%02d", @date[ 3 .. 5 ] ); - # $date[1] = $month_to_num{ $date[1] }; # <--line_0 - # @xdate = split( /[:\/\s]/, $log->field('t') ); # <--line_1 - - ( - $imax_next >= 0 - || $imax_prev >= 0 - || TEST_MARGINAL_EQ_ALIGNMENT - ) - && $j0_eq_pad >= -$j0_max_pad - && $j0_eq_pad <= $j0_max_pad - ) - { + # $date[1] = $month_to_num{ $date[1] }; # <--line_0 + # @xdate = split( /[:\/\s]/, $log->field('t') ); # <--line_1 + # $day = sprintf( "%04d/%02d/%02d", @date[ 2, 1, 0 ] ); + # $time = sprintf( "%02d:%02d:%02d", @date[ 3 .. 5 ] ); - # But do not do this if there is a comma before the '='. - # For example, the first two lines below have commas and - # therefore are not allowed to align with lines 3 & 4: + # Likewise, if we reverse the two pairs we want the same result - # my ( $x, $y ) = $self->Size(); #<--line_0 - # my ( $left, $top, $right, $bottom ) = $self->Window(); #<--l_1 - # my $vx = $right - $left; - # my $vy = $bottom - $top; + # $day = sprintf( "%04d/%02d/%02d", @date[ 2, 1, 0 ] ); + # $time = sprintf( "%02d:%02d:%02d", @date[ 3 .. 5 ] ); + # $date[1] = $month_to_num{ $date[1] }; # <--line_0 + # @xdate = split( /[:\/\s]/, $log->field('t') ); # <--line_1 - if ( $rpatterns_0->[0] !~ /,/ && $rpatterns_1->[0] !~ /,/ ) { - $imax_align = 0; - } + ( + $imax_next >= 0 + || $imax_prev >= 0 + || TEST_MARGINAL_EQ_ALIGNMENT + ) + && $j0_eq_pad >= -$j0_max_pad + && $j0_eq_pad <= $j0_max_pad + ) + { + + # But do not do this if there is a comma before the '='. + # For example, the first two lines below have commas and + # therefore are not allowed to align with lines 3 & 4: + + # my ( $x, $y ) = $self->Size(); #<--line_0 + # my ( $left, $top, $right, $bottom ) = $self->Window(); #<--l_1 + # my $vx = $right - $left; + # my $vy = $bottom - $top; + + if ( $rpatterns_0->[0] !~ /,/ && $rpatterns_1->[0] !~ /,/ ) { + $imax_align = 0; } } + } - return ( $is_marginal, $imax_align ); - } ## end sub is_marginal_match -} ## end closure for sub is_marginal_match + return ( $is_marginal, $imax_align ); +} ## end sub is_marginal_match sub get_extra_leading_spaces {