"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "lib/Perl/Tidy/Formatter.pm" between
Perl-Tidy-20191203.tar.gz and Perl-Tidy-20200110.tar.gz

About: Perltidy is a Perl script indenter and reformatter (beautifier).

Formatter.pm  (Perl-Tidy-20191203):Formatter.pm  (Perl-Tidy-20200110)
skipping to change at line 15 skipping to change at line 15
# #
# WARNING: This is not a real class for speed reasons. Only one # WARNING: This is not a real class for speed reasons. Only one
# Formatter may be used. # Formatter may be used.
# #
##################################################################### #####################################################################
package Perl::Tidy::Formatter; package Perl::Tidy::Formatter;
use strict; use strict;
use warnings; use warnings;
use Carp; use Carp;
our $VERSION = '20191203'; our $VERSION = '20200110';
# The Tokenizer will be loaded with the Formatter # The Tokenizer will be loaded with the Formatter
##use Perl::Tidy::Tokenizer; # for is_keyword() ##use Perl::Tidy::Tokenizer; # for is_keyword()
sub Die { sub Die {
my ($msg) = @_; my ($msg) = @_;
Perl::Tidy::Die($msg); Perl::Tidy::Die($msg);
croak "unexpected return from Perl::Tidy::Die"; croak "unexpected return from Perl::Tidy::Die";
} }
skipping to change at line 115 skipping to change at line 115
@block_type_to_go @block_type_to_go
@type_sequence_to_go @type_sequence_to_go
@container_environment_to_go @container_environment_to_go
@bond_strength_to_go @bond_strength_to_go
@forced_breakpoint_to_go @forced_breakpoint_to_go
@token_lengths_to_go @token_lengths_to_go
@summed_lengths_to_go @summed_lengths_to_go
@levels_to_go @levels_to_go
@leading_spaces_to_go @leading_spaces_to_go
@reduced_spaces_to_go @reduced_spaces_to_go
@matching_token_to_go
@mate_index_to_go @mate_index_to_go
@ci_levels_to_go @ci_levels_to_go
@nesting_depth_to_go @nesting_depth_to_go
@nobreak_to_go @nobreak_to_go
@old_breakpoint_to_go @old_breakpoint_to_go
@tokens_to_go @tokens_to_go
@K_to_go @K_to_go
@types_to_go @types_to_go
@inext_to_go @inext_to_go
@iprev_to_go @iprev_to_go
skipping to change at line 667 skipping to change at line 666
$saw_END_or_DATA_ = 0; $saw_END_or_DATA_ = 0;
@block_type_to_go = (); @block_type_to_go = ();
@type_sequence_to_go = (); @type_sequence_to_go = ();
@container_environment_to_go = (); @container_environment_to_go = ();
@bond_strength_to_go = (); @bond_strength_to_go = ();
@forced_breakpoint_to_go = (); @forced_breakpoint_to_go = ();
@summed_lengths_to_go = (); # line length to start of ith token @summed_lengths_to_go = (); # line length to start of ith token
@token_lengths_to_go = (); @token_lengths_to_go = ();
@levels_to_go = (); @levels_to_go = ();
@matching_token_to_go = ();
@mate_index_to_go = (); @mate_index_to_go = ();
@ci_levels_to_go = (); @ci_levels_to_go = ();
@nesting_depth_to_go = (0); @nesting_depth_to_go = (0);
@nobreak_to_go = (); @nobreak_to_go = ();
@old_breakpoint_to_go = (); @old_breakpoint_to_go = ();
@tokens_to_go = (); @tokens_to_go = ();
@K_to_go = (); @K_to_go = ();
@types_to_go = (); @types_to_go = ();
@leading_spaces_to_go = (); @leading_spaces_to_go = ();
@reduced_spaces_to_go = (); @reduced_spaces_to_go = ();
skipping to change at line 841 skipping to change at line 839
} }
sub Fault { sub Fault {
my ($msg) = @_; my ($msg) = @_;
# This routine is called for errors that really should not occur # This routine is called for errors that really should not occur
# except if there has been a bug introduced by a recent program change # except if there has been a bug introduced by a recent program change
my ( $package0, $filename0, $line0, $subroutine0 ) = caller(0); my ( $package0, $filename0, $line0, $subroutine0 ) = caller(0);
my ( $package1, $filename1, $line1, $subroutine1 ) = caller(1); my ( $package1, $filename1, $line1, $subroutine1 ) = caller(1);
my ( $package2, $filename2, $line2, $subroutine2 ) = caller(2); my ( $package2, $filename2, $line2, $subroutine2 ) = caller(2);
my $input_stream_name = $logger_object->get_input_stream_name();
Die(<<EOM); Die(<<EOM);
============================================================================== ==============================================================================
Fault detected at line $line0 of sub '$subroutine1' While operating on input stream with name: '$input_stream_name'
A fault was detected at line $line0 of sub '$subroutine1'
in file '$filename1' in file '$filename1'
which was called from line $line1 of sub '$subroutine2' which was called from line $line1 of sub '$subroutine2'
Message: '$msg' Message: '$msg'
This is probably an error introduced by a recent programming change. This is probably an error introduced by a recent programming change.
============================================================================== ==============================================================================
EOM EOM
# This is for Perl-Critic # This is for Perl-Critic
return; return;
} }
skipping to change at line 1575 skipping to change at line 1575
black_box( $line_of_tokens, $output_line_number ); black_box( $line_of_tokens, $output_line_number );
} }
# Handle Format Skipping (FS) and Verbatim (VB) Lines # Handle Format Skipping (FS) and Verbatim (VB) Lines
if ( $CODE_type eq 'VB' || $CODE_type eq 'FS' ) { if ( $CODE_type eq 'VB' || $CODE_type eq 'FS' ) {
$self->write_unindented_line("$input_line"); $self->write_unindented_line("$input_line");
$file_writer_object->reset_consecutive_blank_lines(); $file_writer_object->reset_consecutive_blank_lines();
next; next;
} }
# Handle block comment to be deleted
elsif ( $CODE_type eq 'DEL' ) {
$self->flush();
next;
}
# Handle all other lines of code # Handle all other lines of code
$self->print_line_of_tokens($line_of_tokens); $self->print_line_of_tokens($line_of_tokens);
} }
# handle line of non-code.. # handle line of non-code..
else { else {
# set special flags # set special flags
my $skip_line = 0; my $skip_line = 0;
my $tee_line = 0; my $tee_line = 0;
skipping to change at line 1726 skipping to change at line 1732
my $rlevels = $line_of_tokens_old->{_rlevels}; my $rlevels = $line_of_tokens_old->{_rlevels};
my $rslevels = $line_of_tokens_old->{_rslevels}; my $rslevels = $line_of_tokens_old->{_rslevels};
my $rci_levels = $line_of_tokens_old->{_rci_levels}; my $rci_levels = $line_of_tokens_old->{_rci_levels};
my $rnesting_blocks = $line_of_tokens_old->{_rnesting_blocks}; my $rnesting_blocks = $line_of_tokens_old->{_rnesting_blocks};
my $rnesting_tokens = $line_of_tokens_old->{_rnesting_tokens}; my $rnesting_tokens = $line_of_tokens_old->{_rnesting_tokens};
my $jmax = @{$rtokens} - 1; my $jmax = @{$rtokens} - 1;
if ( $jmax >= 0 ) { if ( $jmax >= 0 ) {
$Kfirst = defined($Klimit) ? $Klimit + 1 : 0; $Kfirst = defined($Klimit) ? $Klimit + 1 : 0;
foreach my $j ( 0 .. $jmax ) { foreach my $j ( 0 .. $jmax ) {
# Clip negative nesting depths to zero to avoid problems.
# Negative values can occur in files with unbalanced containers
my $slevel = $rslevels->[$j];
if ( $slevel < 0 ) { $slevel = 0 }
my @tokary; my @tokary;
@tokary[ @tokary[
_TOKEN_, _TYPE_, _TOKEN_, _TYPE_,
_BLOCK_TYPE_, _CONTAINER_TYPE_, _BLOCK_TYPE_, _CONTAINER_TYPE_,
_CONTAINER_ENVIRONMENT_, _TYPE_SEQUENCE_, _CONTAINER_ENVIRONMENT_, _TYPE_SEQUENCE_,
_LEVEL_, _LEVEL_TRUE_, _LEVEL_, _LEVEL_TRUE_,
_SLEVEL_, _CI_LEVEL_, _SLEVEL_, _CI_LEVEL_,
_LINE_INDEX_, _LINE_INDEX_,
] ]
= ( = (
$rtokens->[$j], $rtoken_type->[$j], $rtokens->[$j], $rtoken_type->[$j],
$rblock_type->[$j], $rcontainer_type->[$j], $rblock_type->[$j], $rcontainer_type->[$j],
$rcontainer_environment->[$j], $rtype_sequence->[$j], $rcontainer_environment->[$j], $rtype_sequence->[$j],
$rlevels->[$j], $rlevels->[$j], $rlevels->[$j], $rlevels->[$j],
$rslevels->[$j], $rci_levels->[$j], $slevel, $rci_levels->[$j],
$input_line_no, $input_line_no,
); );
push @{$rLL}, \@tokary; push @{$rLL}, \@tokary;
} }
$Klimit = @{$rLL} - 1; $Klimit = @{$rLL} - 1;
# Need to remember if we can trim the input line # Need to remember if we can trim the input line
$line_of_tokens->{_ended_in_blank_token} = $line_of_tokens->{_ended_in_blank_token} =
$rtoken_type->[$jmax] eq 'b'; $rtoken_type->[$jmax] eq 'b';
skipping to change at line 2386 skipping to change at line 2398
&& !defined( $rLL_new->[$Kprev]->[$key] ) ) && !defined( $rLL_new->[$Kprev]->[$key] ) )
{ {
$rLL_new->[$Kprev]->[$key] = $Ktop; $rLL_new->[$Kprev]->[$key] = $Ktop;
$Kprev -= 1; $Kprev -= 1;
} }
}; };
# A sub to store one token in the new array # A sub to store one token in the new array
# All new tokens must be stored by this sub so that it can update # All new tokens must be stored by this sub so that it can update
# all data structures on the fly. # all data structures on the fly.
my $last_nonblank_type = ';'; my $last_nonblank_type = ';';
my $store_token = sub { my $last_nonblank_token = ';';
my $last_nonblank_block_type = '';
my $store_token = sub {
my ($item) = @_; my ($item) = @_;
# This will be the index of this item in the new array # This will be the index of this item in the new array
my $KK_new = @{$rLL_new}; my $KK_new = @{$rLL_new};
# check for a sequenced item (i.e., container or ?/:) # check for a sequenced item (i.e., container or ?/:)
my $type_sequence = $item->[_TYPE_SEQUENCE_]; my $type_sequence = $item->[_TYPE_SEQUENCE_];
if ($type_sequence) { if ($type_sequence) {
$link_back->( $KK_new, _KNEXT_SEQ_ITEM_ ); $link_back->( $KK_new, _KNEXT_SEQ_ITEM_ );
skipping to change at line 2434 skipping to change at line 2448
# find the length of this token # find the length of this token
my $token_length = length( $item->[_TOKEN_] ); my $token_length = length( $item->[_TOKEN_] );
# and update the cumulative length # and update the cumulative length
$cumulative_length += $token_length; $cumulative_length += $token_length;
# Save the length sum to just AFTER this token # Save the length sum to just AFTER this token
$item->[_CUMULATIVE_LENGTH_] = $cumulative_length; $item->[_CUMULATIVE_LENGTH_] = $cumulative_length;
my $type = $item->[_TYPE_]; my $type = $item->[_TYPE_];
if ( $type ne 'b' ) { $last_nonblank_type = $type }
# trim side comments
if ( $type eq '#' ) {
$item->[_TOKEN_] =~ s/\s*$//;
}
if ( $type && $type ne 'b' && $type ne '#' ) {
$last_nonblank_type = $type;
$last_nonblank_token = $item->[_TOKEN_];
$last_nonblank_block_type = $item->[_BLOCK_TYPE_];
}
# and finally, add this item to the new array # and finally, add this item to the new array
push @{$rLL_new}, $item; push @{$rLL_new}, $item;
}; };
my $store_token_and_space = sub { my $store_token_and_space = sub {
my ( $item, $want_space ) = @_; my ( $item, $want_space ) = @_;
# store a token with preceding space if requested and needed # store a token with preceding space if requested and needed
skipping to change at line 2764 skipping to change at line 2788
my $last_type_sequence = $type_sequence; my $last_type_sequence = $type_sequence;
$type_sequence = $rtoken_vars->[_TYPE_SEQUENCE_]; $type_sequence = $rtoken_vars->[_TYPE_SEQUENCE_];
# Handle a blank space ... # Handle a blank space ...
if ( $type eq 'b' ) { if ( $type eq 'b' ) {
# Delete it if not wanted by whitespace rules # Delete it if not wanted by whitespace rules
# or we are deleting all whitespace # or we are deleting all whitespace
# Note that whitespace flag is a flag indicating whether a # Note that whitespace flag is a flag indicating whether a
# white space BEFORE the token is needed # white space BEFORE the token is needed
next if ( $KK >= $Kmax ); # skip terminal blank next if ( $KK >= $Klast ); # skip terminal blank
my $Knext = $KK + 1; my $Knext = $KK + 1;
my $ws = $rwhitespace_flags->[$Knext]; my $ws = $rwhitespace_flags->[$Knext];
if ( $ws == -1 if ( $ws == -1
|| $rOpts_delete_old_whitespace ) || $rOpts_delete_old_whitespace )
{ {
# FIXME: maybe switch to using _new # FIXME: maybe switch to using _new
my $Kp = $self->K_previous_nonblank($KK); my $Kp = $self->K_previous_nonblank($KK);
next unless defined($Kp); next unless defined($Kp);
my $token_p = $rLL->[$Kp]->[_TOKEN_]; my $token_p = $rLL->[$Kp]->[_TOKEN_];
skipping to change at line 2988 skipping to change at line 3012
# This avoids having to split this token in the pre-tokenizer # This avoids having to split this token in the pre-tokenizer
elsif ( $type eq 'n' ) { elsif ( $type eq 'n' ) {
if ( $token =~ /^x\d+/ ) { if ( $token =~ /^x\d+/ ) {
$token =~ s/x/x /; $token =~ s/x/x /;
$rtoken_vars->[_TOKEN_] = $token; $rtoken_vars->[_TOKEN_] = $token;
} }
} }
# check a quote for problems # check a quote for problems
elsif ( $type eq 'Q' ) { elsif ( $type eq 'Q' ) {
$check_Q->( $KK, $Kfirst );
}
# handle semicolons
elsif ( $type eq ';' ) {
# Remove unnecessary semicolons, but not after bare
# blocks, where it could be unsafe if the brace is
# mistokenized.
if (
$rOpts->{'delete-semicolons'}
&& (
(
$last_nonblank_type eq '}'
&& (
$is_block_without_semicolon{
$last_nonblank_block_type}
|| $last_nonblank_block_type =~ /$SUB_PATTERN/
|| $last_nonblank_block_type =~ /^\w+:$/ )
)
|| $last_nonblank_type eq ';'
)
)
{
# This is ready to go but is commented out because there is # This looks like a deletable semicolon, but even if a
# still identical logic in sub break_lines. # semicolon can be deleted it is necessarily best to do so.
# $check_Q->($KK, $Kfirst); # We apply these additional rules for deletion:
# - Always ok to delete a ';' at the end of a line
# - Never delete a ';' before a '#' because it would
# promote it to a block comment.
# - If a semicolon is not at the end of line, then only
# delete if it is followed by another semicolon or closing
# token. This includes the comment rule. It may take
# two passes to get to a final state, but it is a little
# safer. For example, keep the first semicolon here:
# eval { sub bubba { ok(0) }; ok(0) } || ok(1);
# It is not required but adds some clarity.
my $ok_to_delete = 1;
if ( $KK < $Klast ) {
my $Kn = $self->K_next_nonblank($KK);
if ( defined($Kn) && $Kn <= $Klast ) {
my $next_nonblank_token_type =
$rLL->[$Kn]->[_TYPE_];
$ok_to_delete = $next_nonblank_token_type eq ';'
|| $next_nonblank_token_type eq '}';
}
}
if ($ok_to_delete) {
note_deleted_semicolon();
next;
}
else {
write_logfile_entry("Extra ';'\n");
}
}
} }
elsif ($type_sequence) { elsif ($type_sequence) {
# if ( $is_opening_token{$token} ) { # if ( $is_opening_token{$token} ) {
# } # }
if ( $is_closing_token{$token} ) { if ( $is_closing_token{$token} ) {
# Insert a tentative missing semicolon if the next token is # Insert a tentative missing semicolon if the next token is
skipping to change at line 3239 skipping to change at line 3316
return 'SBCX'; return 'SBCX';
} }
elsif ($is_static_block_comment) { elsif ($is_static_block_comment) {
return 'SBC'; return 'SBC';
} }
else { else {
return 'BC'; return 'BC';
} }
} }
=pod
# NOTE: This does not work yet. Version in print-line-of-tokens
# is Still used until fixed
# compare input/output indentation except for continuation lines
# (because they have an unknown amount of initial blank space)
# and lines which are quotes (because they may have been outdented)
# Note: this test is placed here because we know the continuation flag
# at this point, which allows us to avoid non-meaningful checks.
my $structural_indentation_level = $rLL->[$Kfirst]->[_LEVEL_];
compare_indentation_levels( $guessed_indentation_level,
$structural_indentation_level )
unless ( $rLL->[$Kfirst]->[_CI_LEVEL_] > 0
|| $guessed_indentation_level == 0
&& $rLL->[$Kfirst]->[_TYPE_] eq 'Q' );
=cut
# Patch needed for MakeMaker. Do not break a statement # Patch needed for MakeMaker. Do not break a statement
# in which $VERSION may be calculated. See MakeMaker.pm; # in which $VERSION may be calculated. See MakeMaker.pm;
# this is based on the coding in it. # this is based on the coding in it.
# The first line of a file that matches this will be eval'd: # The first line of a file that matches this will be eval'd:
# /([\$*])(([\w\:\']*)\bVERSION)\b.*\=/ # /([\$*])(([\w\:\']*)\bVERSION)\b.*\=/
# Examples: # Examples:
# *VERSION = \'1.01'; # *VERSION = \'1.01';
# ( $VERSION ) = '$Revision: 1.74 $ ' =~ /\$Revision:\s+([^\s]+)/; # ( $VERSION ) = '$Revision: 1.74 $ ' =~ /\$Revision:\s+([^\s]+)/;
# We will pass such a line straight through without breaking # We will pass such a line straight through without breaking
# it unless -npvl is used. # it unless -npvl is used.
skipping to change at line 3633 skipping to change at line 3693
# the input file then we will allow it to remain broken. Otherwise we will # the input file then we will allow it to remain broken. Otherwise we will
# set a flag to keep it together in later formatting steps. # set a flag to keep it together in later formatting steps.
# The flag which is set here will be checked in two places: # The flag which is set here will be checked in two places:
# 'sub print_line_of_tokens' and 'sub starting_one_line_block' # 'sub print_line_of_tokens' and 'sub starting_one_line_block'
my $self = shift; my $self = shift;
my $rLL = $self->{rLL}; my $rLL = $self->{rLL};
return unless ( defined($rLL) && @{$rLL} ); return unless ( defined($rLL) && @{$rLL} );
return unless ( $rOpts->{'one-line-block-nesting'} );
my $K_opening_container = $self->{K_opening_container}; my $K_opening_container = $self->{K_opening_container};
my $K_closing_container = $self->{K_closing_container}; my $K_closing_container = $self->{K_closing_container};
my $rbreak_container = $self->{rbreak_container}; my $rbreak_container = $self->{rbreak_container};
my $rshort_nested = $self->{rshort_nested}; my $rshort_nested = $self->{rshort_nested};
my $rcontainer_map = $self->{rcontainer_map}; my $rcontainer_map = $self->{rcontainer_map};
my $rlines = $self->{rlines}; my $rlines = $self->{rlines};
# Variables needed for estimating line lengths # Variables needed for estimating line lengths
my $starting_indent; my $starting_indent;
my $starting_lentot; my $starting_lentot;
skipping to change at line 4621 skipping to change at line 4683
$Klast_out = $Klast; $Klast_out = $Klast;
} }
# It is only safe to trim the actual line text if the input # It is only safe to trim the actual line text if the input
# line had a terminal blank token. Otherwise, we may be # line had a terminal blank token. Otherwise, we may be
# in a quote. # in a quote.
if ( $line_of_tokens->{_ended_in_blank_token} ) { if ( $line_of_tokens->{_ended_in_blank_token} ) {
$line_of_tokens->{_line_text} =~ s/\s+$//; $line_of_tokens->{_line_text} =~ s/\s+$//;
} }
$line_of_tokens->{_rK_range} = [ $Kfirst, $Klast ]; $line_of_tokens->{_rK_range} = [ $Kfirst, $Klast ];
# Deleting semicolons can create new empty code lines
# which should be marked as blank
if ( !defined($Kfirst) ) {
my $code_type = $line_of_tokens->{_code_type};
if ( !$code_type ) {
$line_of_tokens->{_code_type} = 'BL';
}
}
} }
} }
# There shouldn't be any nodes beyond the last one unless we start # There shouldn't be any nodes beyond the last one unless we start
# allowing 'link_after' calls # allowing 'link_after' calls
if ( defined($inext) ) { if ( defined($inext) ) {
Fault("unexpected tokens at end of file when reconstructing lines"); Fault("unexpected tokens at end of file when reconstructing lines");
} }
skipping to change at line 5523 skipping to change at line 5594
: "semicolon was"; : "semicolon was";
write_logfile_entry( write_logfile_entry(
"$deleted_semicolon_count unnecessary $what deleted:\n"); "$deleted_semicolon_count unnecessary $what deleted:\n");
write_logfile_entry( write_logfile_entry(
" $first at input line $first_deleted_semicolon_at\n"); " $first at input line $first_deleted_semicolon_at\n");
if ( $deleted_semicolon_count > 1 ) { if ( $deleted_semicolon_count > 1 ) {
write_logfile_entry( write_logfile_entry(
" Last at input line $last_deleted_semicolon_at\n"); " Last at input line $last_deleted_semicolon_at\n");
} }
write_logfile_entry(" (Use -ndsc to prevent semicolon deletion)\n"); write_logfile_entry(" (Use -ndsm to prevent semicolon deletion)\n");
write_logfile_entry("\n"); write_logfile_entry("\n");
} }
if ( $embedded_tab_count > 0 ) { if ( $embedded_tab_count > 0 ) {
my $first = ( $embedded_tab_count > 1 ) ? "First" : ""; my $first = ( $embedded_tab_count > 1 ) ? "First" : "";
my $what = my $what =
( $embedded_tab_count > 1 ) ( $embedded_tab_count > 1 )
? "quotes or patterns" ? "quotes or patterns"
: "quote or pattern"; : "quote or pattern";
write_logfile_entry("$embedded_tab_count $what had embedded tabs:\n"); write_logfile_entry("$embedded_tab_count $what had embedded tabs:\n");
skipping to change at line 6934 skipping to change at line 7005
$tokens_to_go[$max_index_to_go] = $token; $tokens_to_go[$max_index_to_go] = $token;
$types_to_go[$max_index_to_go] = $type; $types_to_go[$max_index_to_go] = $type;
$nobreak_to_go[$max_index_to_go] = $flag; $nobreak_to_go[$max_index_to_go] = $flag;
$old_breakpoint_to_go[$max_index_to_go] = 0; $old_breakpoint_to_go[$max_index_to_go] = 0;
$forced_breakpoint_to_go[$max_index_to_go] = 0; $forced_breakpoint_to_go[$max_index_to_go] = 0;
$block_type_to_go[$max_index_to_go] = $block_type; $block_type_to_go[$max_index_to_go] = $block_type;
$type_sequence_to_go[$max_index_to_go] = $type_sequence; $type_sequence_to_go[$max_index_to_go] = $type_sequence;
$container_environment_to_go[$max_index_to_go] = $container_environment; $container_environment_to_go[$max_index_to_go] = $container_environment;
$ci_levels_to_go[$max_index_to_go] = $ci_level; $ci_levels_to_go[$max_index_to_go] = $ci_level;
$mate_index_to_go[$max_index_to_go] = -1; $mate_index_to_go[$max_index_to_go] = -1;
$matching_token_to_go[$max_index_to_go] = '';
$bond_strength_to_go[$max_index_to_go] = 0; $bond_strength_to_go[$max_index_to_go] = 0;
# Note: negative levels are currently retained as a diagnostic so that # Note: negative levels are currently retained as a diagnostic so that
# the 'final indentation level' is correctly reported for bad scripts. # the 'final indentation level' is correctly reported for bad scripts.
# But this means that every use of $level as an index must be checked. # But this means that every use of $level as an index must be checked.
# If this becomes too much of a problem, we might give up and just clip # If this becomes too much of a problem, we might give up and just clip
# them at zero. # them at zero.
## $levels_to_go[$max_index_to_go] = ( $level > 0 ) ? $level : 0; ## $levels_to_go[$max_index_to_go] = ( $level > 0 ) ? $level : 0;
$levels_to_go[$max_index_to_go] = $level; $levels_to_go[$max_index_to_go] = $level;
$nesting_depth_to_go[$max_index_to_go] = ( $slevel >= 0 ) ? $slevel : 0; $nesting_depth_to_go[$max_index_to_go] = ( $slevel >= 0 ) ? $slevel : 0;
skipping to change at line 6990 skipping to change at line 7060
} }
FORMATTER_DEBUG_FLAG_STORE && do { FORMATTER_DEBUG_FLAG_STORE && do {
my ( $a, $b, $c ) = caller(); my ( $a, $b, $c ) = caller();
print STDOUT print STDOUT
"STORE: from $a $c: storing token $token type $type lev=$level slev=$slevel at $ max_index_to_go\n"; "STORE: from $a $c: storing token $token type $type lev=$level slev=$slevel at $ max_index_to_go\n";
}; };
return; return;
} }
sub insert_new_token_to_go {
# insert a new token into the output stream. use same level as
# previous token; assumes a character at max_index_to_go.
my ( $self, @args ) = @_;
save_current_token();
( $token, $type, $slevel, $no_internal_newlines ) = @args;
if ( $max_index_to_go == UNDEFINED_INDEX ) {
warning("code bug: bad call to insert_new_token_to_go\n");
}
$level = $levels_to_go[$max_index_to_go];
# FIXME: it seems to be necessary to use the next, rather than
# previous, value of this variable when creating a new blank (align.t)
#my $slevel = $nesting_depth_to_go[$max_index_to_go];
$ci_level = $ci_levels_to_go[$max_index_to_go];
$container_environment = $container_environment_to_go[$max_index_to_go];
$in_continued_quote = 0;
$block_type = "";
$type_sequence = "";
# store an undef for the K value to catch unexpected usage
# This routine is only called by add_closing_side_comments, and
# eventually that call will be eliminated.
$Ktoken_vars = undef;
$self->store_token_to_go();
restore_current_token();
return;
}
sub copy_hash { sub copy_hash {
my ($rold_token_hash) = @_; my ($rold_token_hash) = @_;
my %new_token_hash = my %new_token_hash =
map { ( $_, $rold_token_hash->{$_} ) } keys %{$rold_token_hash}; map { ( $_, $rold_token_hash->{$_} ) } keys %{$rold_token_hash};
return \%new_token_hash; return \%new_token_hash;
} }
sub copy_array { sub copy_array {
my ($rold) = @_; my ($rold) = @_;
my @new = map { $_ } @{$rold}; my @new = map { $_ } @{$rold};
skipping to change at line 7103 skipping to change at line 7141
my $rK_range = $line_of_tokens->{_rK_range}; my $rK_range = $line_of_tokens->{_rK_range};
my ( $K_first, $K_last ) = @{$rK_range}; my ( $K_first, $K_last ) = @{$rK_range};
my $rLL = $self->{rLL}; my $rLL = $self->{rLL};
my $rbreak_container = $self->{rbreak_container}; my $rbreak_container = $self->{rbreak_container};
my $rshort_nested = $self->{rshort_nested}; my $rshort_nested = $self->{rshort_nested};
if ( !defined($K_first) ) { if ( !defined($K_first) ) {
# Unexpected blank line.. # Empty line: This can happen if tokens are deleted, for example
# Calling routine was supposed to handle this # with the -mangle parameter
Warn(
"Programming Error: Unexpected Blank Line in print_line_of_tokens. Ignoring"
);
return; return;
} }
$no_internal_newlines = 1 - $rOpts_add_newlines; $no_internal_newlines = 1 - $rOpts_add_newlines;
my $is_comment = my $is_comment =
( $K_first == $K_last && $rLL->[$K_first]->[_TYPE_] eq '#' ); ( $K_first == $K_last && $rLL->[$K_first]->[_TYPE_] eq '#' );
my $is_static_block_comment_without_leading_space = my $is_static_block_comment_without_leading_space =
$CODE_type eq 'SBCX'; $CODE_type eq 'SBCX';
$is_static_block_comment = $is_static_block_comment =
$CODE_type eq 'SBC' || $is_static_block_comment_without_leading_space; $CODE_type eq 'SBC' || $is_static_block_comment_without_leading_space;
skipping to change at line 7170 skipping to change at line 7205
$block_type = ""; $block_type = "";
$container_type = ""; $container_type = "";
$container_environment = ""; $container_environment = "";
$type_sequence = ""; $type_sequence = "";
###################################### ######################################
# Handle a block (full-line) comment.. # Handle a block (full-line) comment..
###################################### ######################################
if ($is_comment) { if ($is_comment) {
if ( $rOpts->{'delete-block-comments'} ) { return }
if ( $rOpts->{'tee-block-comments'} ) { if ( $rOpts->{'tee-block-comments'} ) {
$file_writer_object->tee_on(); $file_writer_object->tee_on();
} }
destroy_one_line_block(); destroy_one_line_block();
$self->output_line_to_go(); $self->output_line_to_go();
# output a blank line before block comments # output a blank line before block comments
if ( if (
# unless we follow a blank or comment line # unless we follow a blank or comment line
skipping to change at line 7231 skipping to change at line 7264
$file_writer_object->write_code_line( $file_writer_object->write_code_line(
$rinput_token_array->[0]->[_TOKEN_] . "\n" ); $rinput_token_array->[0]->[_TOKEN_] . "\n" );
$last_line_leading_type = '#'; $last_line_leading_type = '#';
} }
if ( $rOpts->{'tee-block-comments'} ) { if ( $rOpts->{'tee-block-comments'} ) {
$file_writer_object->tee_off(); $file_writer_object->tee_off();
} }
return; return;
} }
# TODO: Move to sub scan_comments
# compare input/output indentation except for continuation lines # compare input/output indentation except for continuation lines
# (because they have an unknown amount of initial blank space) # (because they have an unknown amount of initial blank space)
# and lines which are quotes (because they may have been outdented) # and lines which are quotes (because they may have been outdented)
# Note: this test is placed here because we know the continuation flag
# at this point, which allows us to avoid non-meaningful checks.
my $structural_indentation_level = $rinput_token_array->[0]->[_LEVEL_]; my $structural_indentation_level = $rinput_token_array->[0]->[_LEVEL_];
compare_indentation_levels( $guessed_indentation_level, compare_indentation_levels( $guessed_indentation_level,
$structural_indentation_level ) $structural_indentation_level )
unless ( $is_hanging_side_comment unless ( $is_hanging_side_comment
|| $rinput_token_array->[0]->[_CI_LEVEL_] > 0 || $rinput_token_array->[0]->[_CI_LEVEL_] > 0
|| $guessed_indentation_level == 0 || $guessed_indentation_level == 0
&& $rinput_token_array->[0]->[_TYPE_] eq 'Q' ); && $rinput_token_array->[0]->[_TYPE_] eq 'Q' );
########################## ##########################
# Handle indentation-only # Handle indentation-only
skipping to change at line 7348 skipping to change at line 7378
$jmin = 1; $jmin = 1;
} }
foreach my $j ( $jmin .. $jmax ) { foreach my $j ( $jmin .. $jmax ) {
# pull out the local values for this token # pull out the local values for this token
$self->extract_token($j); $self->extract_token($j);
if ( $type eq '#' ) { if ( $type eq '#' ) {
# trim trailing whitespace
# (there is no option at present to prevent this)
$token =~ s/\s*$//;
if ( if (
$rOpts->{'delete-side-comments'} $rOpts->{'delete-side-comments'}
# delete closing side comments if necessary # delete closing side comments if necessary
|| ( $rOpts->{'delete-closing-side-comments'} || ( $rOpts->{'delete-closing-side-comments'}
&& $token =~ /$closing_side_comment_prefix_pattern/o && $token =~ /$closing_side_comment_prefix_pattern/o
&& $last_nonblank_block_type =~ && $last_nonblank_block_type =~
/$closing_side_comment_list_pattern/o ) /$closing_side_comment_list_pattern/o )
) )
{ {
skipping to change at line 7388 skipping to change at line 7414
} }
$j_next = $j_next =
( $rinput_token_array->[ $j + 1 ]->[_TYPE_] eq 'b' ) ( $rinput_token_array->[ $j + 1 ]->[_TYPE_] eq 'b' )
? $j + 2 ? $j + 2
: $j + 1; : $j + 1;
$next_nonblank_token = $rinput_token_array->[$j_next]->[_TOKEN_]; $next_nonblank_token = $rinput_token_array->[$j_next]->[_TOKEN_];
$next_nonblank_token_type = $next_nonblank_token_type =
$rinput_token_array->[$j_next]->[_TYPE_]; $rinput_token_array->[$j_next]->[_TYPE_];
######################
# MAYBE MOVE ELSEWHERE?
######################
if ( $type eq 'Q' ) {
note_embedded_tab() if ( $token =~ "\t" );
# make note of something like '$var = s/xxx/yyy/;'
# in case it should have been '$var =~ s/xxx/yyy/;'
if (
$token =~ /^(s|tr|y|m|\/)/
&& $last_nonblank_token =~ /^(=|==|!=)$/
# preceded by simple scalar
&& $last_last_nonblank_type eq 'i'
&& $last_last_nonblank_token =~ /^\$/
# followed by some kind of termination
# (but give complaint if we can's see far enough ahead)
&& $next_nonblank_token =~ /^[; \)\}]$/
# scalar is not declared
&& !(
$types_to_go[0] eq 'k'
&& $tokens_to_go[0] =~ /^(my|our|local)$/
)
)
{
my $guess = substr( $last_nonblank_token, 0, 1 ) . '~';
complain(
"Note: be sure you want '$last_nonblank_token' instead of '$guess' here\n"
);
}
}
# Do not allow breaks which would promote a side comment to a # Do not allow breaks which would promote a side comment to a
# block comment. In order to allow a break before an opening # block comment. In order to allow a break before an opening
# or closing BLOCK, followed by a side comment, those sections # or closing BLOCK, followed by a side comment, those sections
# of code will handle this flag separately. # of code will handle this flag separately.
my $side_comment_follows = ( $next_nonblank_token_type eq '#' ); my $side_comment_follows = ( $next_nonblank_token_type eq '#' );
my $is_opening_BLOCK = my $is_opening_BLOCK =
( $type eq '{' ( $type eq '{'
&& $token eq '{' && $token eq '{'
&& $block_type && $block_type
&& !$rshort_nested->{$type_sequence} && !$rshort_nested->{$type_sequence}
skipping to change at line 7720 skipping to change at line 7712
$semicolons_before_block_self_destruct--; $semicolons_before_block_self_destruct--;
if ( if (
( $semicolons_before_block_self_destruct < 0 ) ( $semicolons_before_block_self_destruct < 0 )
|| ( $semicolons_before_block_self_destruct == 0 || ( $semicolons_before_block_self_destruct == 0
&& $next_nonblank_token_type !~ /^[b\}]$/ ) && $next_nonblank_token_type !~ /^[b\}]$/ )
) )
{ {
destroy_one_line_block(); destroy_one_line_block();
} }
# Remove unnecessary semicolons, but not after bare
# blocks, where it could be unsafe if the brace is
# mistokenized.
if (
(
$last_nonblank_token eq '}'
&& (
$is_block_without_semicolon{
$last_nonblank_block_type}
|| $last_nonblank_block_type =~ /$SUB_PATTERN/
|| $last_nonblank_block_type =~ /^\w+:$/ )
)
|| $last_nonblank_type eq ';'
)
{
if (
$rOpts->{'delete-semicolons'}
# don't delete ; before a # because it would promote it
# to a block comment
&& ( $next_nonblank_token_type ne '#' )
)
{
note_deleted_semicolon();
$self->output_line_to_go()
unless ( $no_internal_newlines
|| $index_start_one_line_block != UNDEFINED_INDEX );
next;
}
else {
write_logfile_entry("Extra ';'\n");
}
}
$self->store_token_to_go(); $self->store_token_to_go();
$self->output_line_to_go() $self->output_line_to_go()
unless ( $no_internal_newlines unless ( $no_internal_newlines
|| ( $rOpts_keep_interior_semicolons && $j < $jmax ) || ( $rOpts_keep_interior_semicolons && $j < $jmax )
|| ( $next_nonblank_token eq '}' ) ); || ( $next_nonblank_token eq '}' ) );
} }
# handle here_doc target string # handle here_doc target string
skipping to change at line 7857 skipping to change at line 7815
FORMATTER_DEBUG_FLAG_OUTPUT && do { FORMATTER_DEBUG_FLAG_OUTPUT && do {
my ( $a, $b, $c ) = caller; my ( $a, $b, $c ) = caller;
write_diagnostics( write_diagnostics(
"OUTPUT: output_line_to_go called: $a $c $last_nonblank_type $last_nonblank_toke n, one_line=$index_start_one_line_block, tokens to write=$max_index_to_go\n" "OUTPUT: output_line_to_go called: $a $c $last_nonblank_type $last_nonblank_toke n, one_line=$index_start_one_line_block, tokens to write=$max_index_to_go\n"
); );
my $output_str = join "", @tokens_to_go[ 0 .. $max_index_to_go ]; my $output_str = join "", @tokens_to_go[ 0 .. $max_index_to_go ];
write_diagnostics("$output_str\n"); write_diagnostics("$output_str\n");
}; };
# Do not end line in a weld # Do not end line in a weld
# TODO: Move this fix into the routine?
#my $jnb = $max_index_to_go;
#if ( $jnb > 0 && $types_to_go[$jnb] eq 'b' ) { $jnb-- }
return if ( weld_len_right_to_go($max_index_to_go) ); return if ( weld_len_right_to_go($max_index_to_go) );
# just set a tentative breakpoint if we might be in a one-line block # just set a tentative breakpoint if we might be in a one-line block
if ( $index_start_one_line_block != UNDEFINED_INDEX ) { if ( $index_start_one_line_block != UNDEFINED_INDEX ) {
set_forced_breakpoint($max_index_to_go); set_forced_breakpoint($max_index_to_go);
return; return;
} }
## my $cscw_block_comment;
## $cscw_block_comment = $self->add_closing_side_comment()
## if ( $rOpts->{'closing-side-comments'} && $max_index_to_go >= 0 );
my $comma_arrow_count_contained = match_opening_and_closing_tokens(); my $comma_arrow_count_contained = match_opening_and_closing_tokens();
# tell the -lp option we are outputting a batch so it can close # tell the -lp option we are outputting a batch so it can close
# any unfinished items in its stack # any unfinished items in its stack
finish_lp_batch(); finish_lp_batch();
# If this line ends in a code block brace, set breaks at any # If this line ends in a code block brace, set breaks at any
# previous closing code block braces to breakup a chain of code # previous closing code block braces to breakup a chain of code
# blocks on one line. This is very rare but can happen for # blocks on one line. This is very rare but can happen for
# user-defined subs. For example we might be looking at this: # user-defined subs. For example we might be looking at this:
skipping to change at line 7935 skipping to change at line 7886
# anything left to write? # anything left to write?
if ( $imin <= $imax ) { if ( $imin <= $imax ) {
# add a blank line before certain key types but not after a comment # add a blank line before certain key types but not after a comment
if ( $last_line_leading_type !~ /^[#]/ ) { if ( $last_line_leading_type !~ /^[#]/ ) {
my $want_blank = 0; my $want_blank = 0;
my $leading_token = $tokens_to_go[$imin]; my $leading_token = $tokens_to_go[$imin];
my $leading_type = $types_to_go[$imin]; my $leading_type = $types_to_go[$imin];
# blank lines before subs except declarations and one-liners # blank lines before subs except declarations and one-liners
# MCONVERSION LOCATION - for sub tokenization change
if ( $leading_token =~ /^(sub\s)/ && $leading_type eq 'i' ) { if ( $leading_token =~ /^(sub\s)/ && $leading_type eq 'i' ) {
$want_blank = $rOpts->{'blank-lines-before-subs'} $want_blank = $rOpts->{'blank-lines-before-subs'}
if ( if ( $self->terminal_type_i( $imin, $imax ) !~ /^[\;\}]$/ );
terminal_type( \@types_to_go, \@block_type_to_go, $imin,
$imax ) !~ /^[\;\}]$/
);
} }
# break before all package declarations # break before all package declarations
# MCONVERSION LOCATION - for tokenizaton change
elsif ($leading_token =~ /^(package\s)/ elsif ($leading_token =~ /^(package\s)/
&& $leading_type eq 'i' ) && $leading_type eq 'i' )
{ {
$want_blank = $rOpts->{'blank-lines-before-packages'}; $want_blank = $rOpts->{'blank-lines-before-packages'};
} }
# break before certain key blocks except one-liners # break before certain key blocks except one-liners
if ( $leading_token =~ /^(BEGIN|END)$/ && $leading_type eq 'k' ) { if ( $leading_token =~ /^(BEGIN|END)$/ && $leading_type eq 'k' ) {
$want_blank = $rOpts->{'blank-lines-before-subs'} $want_blank = $rOpts->{'blank-lines-before-subs'}
if ( if ( $self->terminal_type_i( $imin, $imax ) ne '}' );
terminal_type( \@types_to_go, \@block_type_to_go, $imin,
$imax ) ne '}'
);
} }
# Break before certain block types if we haven't had a # Break before certain block types if we haven't had a
# break at this level for a while. This is the # break at this level for a while. This is the
# difficult decision.. # difficult decision..
elsif ($leading_type eq 'k' elsif ($leading_type eq 'k'
&& $last_line_leading_type ne 'b' && $last_line_leading_type ne 'b'
&& $leading_token =~ /^(unless|if|while|until|for|foreach)$/ ) && $leading_token =~ /^(unless|if|while|until|for|foreach)$/ )
{ {
my $lc = $nonblank_lines_at_depth[$last_line_leading_level]; my $lc = $nonblank_lines_at_depth[$last_line_leading_level];
skipping to change at line 7981 skipping to change at line 7924
# patch for RT #128216: no blank line inserted at a level change # patch for RT #128216: no blank line inserted at a level change
if ( $levels_to_go[$imin] != $last_line_leading_level ) { if ( $levels_to_go[$imin] != $last_line_leading_level ) {
$lc = 0; $lc = 0;
} }
$want_blank = $want_blank =
$rOpts->{'blanks-before-blocks'} $rOpts->{'blanks-before-blocks'}
&& $lc >= $rOpts->{'long-block-line-count'} && $lc >= $rOpts->{'long-block-line-count'}
&& consecutive_nonblank_lines() >= && consecutive_nonblank_lines() >=
$rOpts->{'long-block-line-count'} $rOpts->{'long-block-line-count'}
&& ( && $self->terminal_type_i( $imin, $imax ) ne '}';
terminal_type( \@types_to_go, \@block_type_to_go, $imin,
$imax ) ne '}'
);
} }
# Check for blank lines wanted before a closing brace # Check for blank lines wanted before a closing brace
if ( $leading_token eq '}' ) { if ( $leading_token eq '}' ) {
if ( $rOpts->{'blank-lines-before-closing-block'} if ( $rOpts->{'blank-lines-before-closing-block'}
&& $block_type_to_go[$imin] && $block_type_to_go[$imin]
&& $block_type_to_go[$imin] =~ && $block_type_to_go[$imin] =~
/$blank_lines_before_closing_block_pattern/ ) /$blank_lines_before_closing_block_pattern/ )
{ {
my $nblanks = $rOpts->{'blank-lines-before-closing-block'}; my $nblanks = $rOpts->{'blank-lines-before-closing-block'};
skipping to change at line 8097 skipping to change at line 8037
) )
{ {
@{$ri_first} = ($imin); @{$ri_first} = ($imin);
@{$ri_last} = ($imax); @{$ri_last} = ($imax);
} }
# otherwise use multiple lines # otherwise use multiple lines
else { else {
( $ri_first, $ri_last, my $colon_count ) = ( $ri_first, $ri_last, my $colon_count ) =
set_continuation_breaks($saw_good_break); $self->set_continuation_breaks($saw_good_break);
break_all_chain_tokens( $ri_first, $ri_last ); $self->break_all_chain_tokens( $ri_first, $ri_last );
break_equals( $ri_first, $ri_last ); break_equals( $ri_first, $ri_last );
# now we do a correction step to clean this up a bit # now we do a correction step to clean this up a bit
# (The only time we would not do this is for debugging) # (The only time we would not do this is for debugging)
if ( $rOpts->{'recombine'} ) { if ( $rOpts->{'recombine'} ) {
( $ri_first, $ri_last ) = ( $ri_first, $ri_last ) =
recombine_breakpoints( $ri_first, $ri_last ); recombine_breakpoints( $ri_first, $ri_last );
} }
insert_final_breaks( $ri_first, $ri_last ) if $colon_count; $self->insert_final_breaks( $ri_first, $ri_last ) if $colon_count;
} }
# do corrector step if -lp option is used # do corrector step if -lp option is used
my $do_not_pad = 0; my $do_not_pad = 0;
if ($rOpts_line_up_parentheses) { if ($rOpts_line_up_parentheses) {
$do_not_pad = correct_lp_indentation( $ri_first, $ri_last ); $do_not_pad = correct_lp_indentation( $ri_first, $ri_last );
} }
$self->unmask_phantom_semicolons( $ri_first, $ri_last ); $self->unmask_phantom_semicolons( $ri_first, $ri_last );
if ( $rOpts_one_line_block_semicolons == 0 ) { if ( $rOpts_one_line_block_semicolons == 0 ) {
$self->delete_one_line_semicolons( $ri_first, $ri_last ); $self->delete_one_line_semicolons( $ri_first, $ri_last );
} }
$self->send_lines_to_vertical_aligner( $ri_first, $ri_last,
$do_not_pad ); # The line breaks for this batch of code have been finalized. Now we
# can to package the results for further processing. We will switch
# from the local '_to_go' buffer arrays (i-index) back to the global
# token arrays (K-index) at this point.
my $rlines_K;
my $index_error;
for ( my $n = 0 ; $n < @{$ri_first} ; $n++ ) {
my $ibeg = $ri_first->[$n];
my $Kbeg = $K_to_go[$ibeg];
my $iend = $ri_last->[$n];
my $Kend = $K_to_go[$iend];
if ( $iend - $ibeg != $Kend - $Kbeg ) {
$index_error = $n unless defined($index_error);
}
push @{$rlines_K},
[ $Kbeg, $Kend, $forced_breakpoint_to_go[$iend] ];
}
# Check correctness of the mapping between the i and K token indexes
if ( defined($index_error) ) {
# Temporary debug code - should never get here
for ( my $n = 0 ; $n < @{$ri_first} ; $n++ ) {
my $ibeg = $ri_first->[$n];
my $Kbeg = $K_to_go[$ibeg];
my $iend = $ri_last->[$n];
my $Kend = $K_to_go[$iend];
my $idiff = $iend - $ibeg;
my $Kdiff = $Kend - $Kbeg;
print STDERR <<EOM;
line $n, irange $ibeg-$iend = $idiff, Krange $Kbeg-$Kend = $Kdiff;
EOM
}
Fault("Index error at line $index_error; i and K ranges differ");
}
my $rbatch_hash = {
rlines_K => $rlines_K,
do_not_pad => $do_not_pad,
ibeg0 => $ri_first->[0],
};
$self->send_lines_to_vertical_aligner($rbatch_hash);
# Insert any requested blank lines after an opening brace. We have to # Insert any requested blank lines after an opening brace. We have to
# skip back before any side comment to find the terminal token # skip back before any side comment to find the terminal token
my $iterm; my $iterm;
for ( $iterm = $imax ; $iterm >= $imin ; $iterm-- ) { for ( $iterm = $imax ; $iterm >= $imin ; $iterm-- ) {
next if $types_to_go[$iterm] eq '#'; next if $types_to_go[$iterm] eq '#';
next if $types_to_go[$iterm] eq 'b'; next if $types_to_go[$iterm] eq 'b';
last; last;
} }
skipping to change at line 8150 skipping to change at line 8132
{ {
my $nblanks = $rOpts->{'blank-lines-after-opening-block'}; my $nblanks = $rOpts->{'blank-lines-after-opening-block'};
Perl::Tidy::VerticalAligner::flush(); Perl::Tidy::VerticalAligner::flush();
$file_writer_object->require_blank_code_lines($nblanks); $file_writer_object->require_blank_code_lines($nblanks);
} }
} }
} }
prepare_for_new_input_lines(); prepare_for_new_input_lines();
## # output any new -cscw block comment
## if ($cscw_block_comment) {
## $self->flush();
## $file_writer_object->write_code_line( $cscw_block_comment . "\n" );
## }
return; return;
} }
sub note_added_semicolon { sub note_added_semicolon {
my ($line_number) = @_; my ($line_number) = @_;
$last_added_semicolon_at = $line_number; $last_added_semicolon_at = $line_number;
if ( $added_semicolon_count == 0 ) { if ( $added_semicolon_count == 0 ) {
$first_added_semicolon_at = $last_added_semicolon_at; $first_added_semicolon_at = $last_added_semicolon_at;
} }
$added_semicolon_count++; $added_semicolon_count++;
write_logfile_entry("Added ';' here\n"); write_logfile_entry("Added ';' here\n");
return; return;
} }
sub note_deleted_semicolon { sub note_deleted_semicolon {
$last_deleted_semicolon_at = $input_line_number; $last_deleted_semicolon_at = $input_line_number;
if ( $deleted_semicolon_count == 0 ) { if ( $deleted_semicolon_count == 0 ) {
$first_deleted_semicolon_at = $last_deleted_semicolon_at; $first_deleted_semicolon_at = $last_deleted_semicolon_at;
} }
$deleted_semicolon_count++; $deleted_semicolon_count++;
write_logfile_entry("Deleted unnecessary ';'\n"); # i hope ;) write_logfile_entry("Deleted unnecessary ';' at line $input_line_number\n");
return; return;
} }
sub note_embedded_tab { sub note_embedded_tab {
$embedded_tab_count++; $embedded_tab_count++;
$last_embedded_tab_at = $input_line_number; $last_embedded_tab_at = $input_line_number;
if ( !$first_embedded_tab_at ) { if ( !$first_embedded_tab_at ) {
$first_embedded_tab_at = $last_embedded_tab_at; $first_embedded_tab_at = $last_embedded_tab_at;
} }
skipping to change at line 8467 skipping to change at line 8444
# For example, we can undo continuation indentation in sort/map/grep chains # For example, we can undo continuation indentation in sort/map/grep chains
# my $dat1 = pack( "n*", # my $dat1 = pack( "n*",
# map { $_, $lookup->{$_} } # map { $_, $lookup->{$_} }
# sort { $a <=> $b } # sort { $a <=> $b }
# grep { $lookup->{$_} ne $default } keys %$lookup ); # grep { $lookup->{$_} ne $default } keys %$lookup );
# To align the map/sort/grep keywords like this: # To align the map/sort/grep keywords like this:
# my $dat1 = pack( "n*", # my $dat1 = pack( "n*",
# map { $_, $lookup->{$_} } # map { $_, $lookup->{$_} }
# sort { $a <=> $b } # sort { $a <=> $b }
# grep { $lookup->{$_} ne $default } keys %$lookup ); # grep { $lookup->{$_} ne $default } keys %$lookup );
my ( $ri_first, $ri_last ) = @_; my ( $self, $ri_first, $ri_last ) = @_;
my ( $line_1, $line_2, $lev_last ); my ( $line_1, $line_2, $lev_last );
my $this_line_is_semicolon_terminated; my $this_line_is_semicolon_terminated;
my $max_line = @{$ri_first} - 1; my $max_line = @{$ri_first} - 1;
# looking at each line of this batch.. # looking at each line of this batch..
# We are looking at leading tokens and looking for a sequence # We are looking at leading tokens and looking for a sequence
# all at the same level and higher level than enclosing lines. # all at the same level and higher level than enclosing lines.
foreach my $line ( 0 .. $max_line ) { foreach my $line ( 0 .. $max_line ) {
my $ibeg = $ri_first->[$line]; my $ibeg = $ri_first->[$line];
skipping to change at line 8606 skipping to change at line 8583
@ci_levels_to_go[ @{$ri_first}[ $line_1 .. $n ] ] = @ci_levels_to_go[ @{$ri_first}[ $line_1 .. $n ] ] =
(0) x ($continuation_line_count); (0) x ($continuation_line_count);
@leading_spaces_to_go[ @{$ri_first}[ $line_1 .. $n ] ] = @leading_spaces_to_go[ @{$ri_first}[ $line_1 .. $n ] ] =
@reduced_spaces_to_go[ @{$ri_first}[ $line_1 .. $n ] ]; @reduced_spaces_to_go[ @{$ri_first}[ $line_1 .. $n ] ];
return; return;
} }
sub pad_token { sub pad_token {
# insert $pad_spaces before token number $ipad # insert $pad_spaces before token number $ipad
my ( $ipad, $pad_spaces ) = @_; my ( $self, $ipad, $pad_spaces ) = @_;
my $rLL = $self->{rLL};
if ( $pad_spaces > 0 ) { if ( $pad_spaces > 0 ) {
$tokens_to_go[$ipad] = ' ' x $pad_spaces . $tokens_to_go[$ipad]; $tokens_to_go[$ipad] = ' ' x $pad_spaces . $tokens_to_go[$ipad];
} }
elsif ( $pad_spaces == -1 && $tokens_to_go[$ipad] eq ' ' ) { elsif ( $pad_spaces == -1 && $tokens_to_go[$ipad] eq ' ' ) {
$tokens_to_go[$ipad] = ""; $tokens_to_go[$ipad] = "";
} }
else { else {
# shouldn't happen # shouldn't happen
return; return;
} }
# Keep token arrays in sync
$self->sync_token_K($ipad);
$token_lengths_to_go[$ipad] += $pad_spaces; $token_lengths_to_go[$ipad] += $pad_spaces;
foreach my $i ( $ipad .. $max_index_to_go ) { foreach my $i ( $ipad .. $max_index_to_go ) {
$summed_lengths_to_go[ $i + 1 ] += $pad_spaces; $summed_lengths_to_go[ $i + 1 ] += $pad_spaces;
} }
return; return;
} }
{ {
my %is_math_op; my %is_math_op;
skipping to change at line 8650 skipping to change at line 8631
# '( $year' to make it line up with the subsequent lines: # '( $year' to make it line up with the subsequent lines:
# #
# if ( ( $Year < 1601 ) # if ( ( $Year < 1601 )
# || ( $Year > 2899 ) # || ( $Year > 2899 )
# || ( $EndYear < 1601 ) # || ( $EndYear < 1601 )
# || ( $EndYear > 2899 ) ) # || ( $EndYear > 2899 ) )
# { # {
# &Error_OutOfRange; # &Error_OutOfRange;
# } # }
# #
my ( $ri_first, $ri_last ) = @_; my ( $self, $ri_first, $ri_last ) = @_;
my $max_line = @{$ri_first} - 1; my $max_line = @{$ri_first} - 1;
# FIXME: move these declarations below # FIXME: move these declarations below
my ( $ibeg, $ibeg_next, $ibegm, $iend, $iendm, $ipad, $pad_spaces, my ( $ibeg, $ibeg_next, $ibegm, $iend, $iendm, $ipad, $pad_spaces,
$tok_next, $type_next, $has_leading_op_next, $has_leading_op ); $tok_next, $type_next, $has_leading_op_next, $has_leading_op );
# looking at each line of this batch.. # looking at each line of this batch..
foreach my $line ( 0 .. $max_line - 1 ) { foreach my $line ( 0 .. $max_line - 1 ) {
# see if the next line begins with a logical operator # see if the next line begins with a logical operator
skipping to change at line 8833 skipping to change at line 8814
} }
# find interior token to pad if necessary # find interior token to pad if necessary
if ( !defined($ipad) ) { if ( !defined($ipad) ) {
for ( my $i = $ibeg ; ( $i < $iend ) && !$ipad ; $i++ ) { for ( my $i = $ibeg ; ( $i < $iend ) && !$ipad ; $i++ ) {
# find any unclosed container # find any unclosed container
next next
unless ( $type_sequence_to_go[$i] unless ( $type_sequence_to_go[$i]
&& $mate_index_to_go[$i] > $iend ); && $self->mate_index_to_go($i) > $iend );
# find next nonblank token to pad # find next nonblank token to pad
$ipad = $inext_to_go[$i]; $ipad = $inext_to_go[$i];
last if ( $ipad > $iend ); last if ( $ipad > $iend );
} }
last unless $ipad; last unless $ipad;
} }
# We cannot pad the first leading token of a file because # We cannot pad the first leading token of a file because
# it could cause a bug in which the starting indentation # it could cause a bug in which the starting indentation
skipping to change at line 8990 skipping to change at line 8971
$ok_to_pad = 0; $ok_to_pad = 0;
last; last;
} }
} }
# don't pad if we end in a broken list # don't pad if we end in a broken list
if ( $l == $max_line ) { if ( $l == $max_line ) {
my $i2 = $ri_last->[$l]; my $i2 = $ri_last->[$l];
if ( $types_to_go[$i2] eq '#' ) { if ( $types_to_go[$i2] eq '#' ) {
my $i1 = $ri_first->[$l]; my $i1 = $ri_first->[$l];
next next if $self->terminal_type_i( $i1, $i2 ) eq ',';
if (
terminal_type( \@types_to_go, \@block_type_to_go,
$i1, $i2 ) eq ','
);
} }
} }
# SPECIAL CHECK 2: # SPECIAL CHECK 2:
# a minus may introduce a quoted variable, and we will # a minus may introduce a quoted variable, and we will
# add the pad only if this line begins with a bare word, # add the pad only if this line begins with a bare word,
# such as for the word 'Button' here: # such as for the word 'Button' here:
# [ # [
# Button => "Print letter \"~$_\"", # Button => "Print letter \"~$_\"",
# -command => [ sub { print "$_[0]\n" }, $_ ], # -command => [ sub { print "$_[0]\n" }, $_ ],
skipping to change at line 9063 skipping to change at line 9040
} }
} }
# we might be able to handle a pad of -1 by removing a blank # we might be able to handle a pad of -1 by removing a blank
# token # token
if ( $pad_spaces < 0 ) { if ( $pad_spaces < 0 ) {
if ( $pad_spaces == -1 ) { if ( $pad_spaces == -1 ) {
if ( $ipad > $ibeg && $types_to_go[ $ipad - 1 ] eq 'b' ) if ( $ipad > $ibeg && $types_to_go[ $ipad - 1 ] eq 'b' )
{ {
pad_token( $ipad - 1, $pad_spaces ); $self->pad_token( $ipad - 1, $pad_spaces );
} }
} }
$pad_spaces = 0; $pad_spaces = 0;
} }
# now apply any padding for alignment # now apply any padding for alignment
if ( $ipad >= 0 && $pad_spaces ) { if ( $ipad >= 0 && $pad_spaces ) {
my $length_t = total_line_length( $ibeg, $iend ); my $length_t = total_line_length( $ibeg, $iend );
if ( $pad_spaces + $length_t <= maximum_line_length($ibeg) ) if ( $pad_spaces + $length_t <= maximum_line_length($ibeg) )
{ {
pad_token( $ipad, $pad_spaces ); $self->pad_token( $ipad, $pad_spaces );
} }
} }
} }
} }
continue { continue {
$iendm = $iend; $iendm = $iend;
$ibegm = $ibeg; $ibegm = $ibeg;
$has_leading_op = $has_leading_op_next; $has_leading_op = $has_leading_op_next;
} # end of loop over lines } # end of loop over lines
return; return;
skipping to change at line 9743 skipping to change at line 9720
# return the balanced string # return the balanced string
return $csc; return $csc;
} }
} }
sub add_closing_side_comment { sub add_closing_side_comment {
my $self = shift; my $self = shift;
# add closing side comments after closing block braces if -csc used # add closing side comments after closing block braces if -csc used
my $cscw_block_comment; my ( $closing_side_comment, $cscw_block_comment );
#--------------------------------------------------------------- #---------------------------------------------------------------
# Step 1: loop through all tokens of this line to accumulate # Step 1: loop through all tokens of this line to accumulate
# the text needed to create the closing side comments. Also see # the text needed to create the closing side comments. Also see
# how the line ends. # how the line ends.
#--------------------------------------------------------------- #---------------------------------------------------------------
my ( $terminal_type, $i_terminal, $i_block_leading_text, my ( $terminal_type, $i_terminal, $i_block_leading_text,
$block_leading_text, $block_line_count, $block_label ) $block_leading_text, $block_line_count, $block_label )
= accumulate_csc_text(); = accumulate_csc_text();
skipping to change at line 9789 skipping to change at line 9766
# .. but not an anonymous sub # .. but not an anonymous sub
# These are not normally of interest, and their closing braces are # These are not normally of interest, and their closing braces are
# often followed by commas or semicolons anyway. This also avoids # often followed by commas or semicolons anyway. This also avoids
# possible erratic output due to line numbering inconsistencies # possible erratic output due to line numbering inconsistencies
# in the cases where their closing braces terminate a line. # in the cases where their closing braces terminate a line.
&& $block_type_to_go[$i_terminal] ne 'sub' && $block_type_to_go[$i_terminal] ne 'sub'
# ..and the corresponding opening brace must is not in this batch # ..and the corresponding opening brace must is not in this batch
# (because we do not need to tag one-line blocks, although this # (because we do not need to tag one-line blocks, although this
# should also be caught with a positive -csci value) # should also be caught with a positive -csci value)
&& $mate_index_to_go[$i_terminal] < 0 && $self->mate_index_to_go($i_terminal) < 0
# ..and either # ..and either
&& ( && (
# this is the last token (line doesn't have a side comment) # this is the last token (line doesn't have a side comment)
!$have_side_comment !$have_side_comment
# or the old side comment is a closing side comment # or the old side comment is a closing side comment
|| $tokens_to_go[$max_index_to_go] =~ || $tokens_to_go[$max_index_to_go] =~
/$closing_side_comment_prefix_pattern/o /$closing_side_comment_prefix_pattern/o
skipping to change at line 9909 skipping to change at line 9886
$token = undef; $token = undef;
$self->unstore_token_to_go() $self->unstore_token_to_go()
if ( $types_to_go[$max_index_to_go] eq '#' ); if ( $types_to_go[$max_index_to_go] eq '#' );
$self->unstore_token_to_go() $self->unstore_token_to_go()
if ( $types_to_go[$max_index_to_go] eq 'b' ); if ( $types_to_go[$max_index_to_go] eq 'b' );
} }
} }
} }
# switch to the new csc (unless we deleted it!) # switch to the new csc (unless we deleted it!)
$tokens_to_go[$max_index_to_go] = $token if $token; if ($token) {
$tokens_to_go[$max_index_to_go] = $token;
$self->sync_token_K($max_index_to_go);
}
} }
# handle case of NO existing closing side comment # handle case of NO existing closing side comment
else { else {
# Remove any existing blank and add another below. # To avoid inserting a new token in the token arrays, we
# This is a tricky point. A side comment needs to have the same level # will just return the new side comment so that it can be
# as the preceding closing brace or else the line will not get the right # inserted just before it is needed in the call to the
# indentation. So even if we have a blank, we are going to replace it. # vertical aligner.
if ( $types_to_go[$max_index_to_go] eq 'b' ) { $closing_side_comment = $token;
unstore_token_to_go();
}
# insert the new side comment into the output token stream
my $type = '#';
my $block_type = '';
my $type_sequence = '';
my $container_environment =
$container_environment_to_go[$max_index_to_go];
my $level = $levels_to_go[$max_index_to_go];
my $slevel = $nesting_depth_to_go[$max_index_to_go];
my $no_internal_newlines = 0;
my $ci_level = $ci_levels_to_go[$max_index_to_go];
my $in_continued_quote = 0;
# insert a blank token
$self->insert_new_token_to_go( ' ', 'b', $slevel,
$no_internal_newlines );
# then the side comment
$self->insert_new_token_to_go( $token, $type, $slevel,
$no_internal_newlines );
} }
} }
return $cscw_block_comment; return ( $closing_side_comment, $cscw_block_comment );
} }
sub previous_nonblank_token { sub previous_nonblank_token {
my ($i) = @_; my ($i) = @_;
my $name = ""; my $name = "";
my $im = $i - 1; my $im = $i - 1;
return "" if ( $im < 0 ); return "" if ( $im < 0 );
if ( $types_to_go[$im] eq 'b' ) { $im--; } if ( $types_to_go[$im] eq 'b' ) { $im--; }
return "" if ( $im < 0 ); return "" if ( $im < 0 );
$name = $tokens_to_go[$im]; $name = $tokens_to_go[$im];
skipping to change at line 9970 skipping to change at line 9927
$im--; $im--;
if ( $im >= 0 && $types_to_go[$im] ne 'b' ) { if ( $im >= 0 && $types_to_go[$im] ne 'b' ) {
$name = $tokens_to_go[$im] . $name; $name = $tokens_to_go[$im] . $name;
} }
} }
return $name; return $name;
} }
sub send_lines_to_vertical_aligner { sub send_lines_to_vertical_aligner {
my ( $self, $ri_first, $ri_last, $do_not_pad ) = @_; my ( $self, $rbatch_hash ) = @_;
# This routine receives a batch of code for which the final line breaks
# have been defined. Here we prepare the lines for passing to the vertical
# aligner. We do the following tasks:
# - mark certain vertical alignment tokens tokens, such as '=', in each line.
# - make minor indentation adjustments
# - insert extra blank spaces to help display certain logical constructions
my $rlines_K = $rbatch_hash->{rlines_K};
if ( !@{$rlines_K} ) {
Fault("Unexpected call with no lines");
return;
}
my $n_last_line = @{$rlines_K} - 1;
my $do_not_pad = $rbatch_hash->{do_not_pad};
my $rLL = $self->{rLL};
my $Klimit = $self->{Klimit};
my ( $Kbeg_next, $Kend_next ) = @{ $rlines_K->[0] };
my $type_beg_next = $rLL->[$Kbeg_next]->[_TYPE_];
my $token_beg_next = $rLL->[$Kbeg_next]->[_TOKEN_];
my $type_end_next = $rLL->[$Kend_next]->[_TYPE_];
# Construct indexes to the global_to_go arrays so that called routines can
# still access those arrays. This might eventually be removed
# when all called routines have been converted to access token values
# in the rLL array instead.
my $ibeg0 = $rbatch_hash->{ibeg0};
my $Kbeg0 = $Kbeg_next;
my ( $ri_first, $ri_last );
foreach my $rline ( @{$rlines_K} ) {
my ( $Kbeg, $Kend ) = @{$rline};
my $ibeg = $ibeg0 + $Kbeg - $Kbeg0;
my $iend = $ibeg0 + $Kend - $Kbeg0;
push @{$ri_first}, $ibeg;
push @{$ri_last}, $iend;
}
#####################################################################
my $valign_batch_number = $self->increment_valign_batch_count(); my $valign_batch_number = $self->increment_valign_batch_count();
my $cscw_block_comment; my ( $cscw_block_comment, $closing_side_comment );
if ( $rOpts->{'closing-side-comments'} && $max_index_to_go >= 0 ) { if ( $rOpts->{'closing-side-comments'} ) {
$cscw_block_comment = $self->add_closing_side_comment(); ( $closing_side_comment, $cscw_block_comment ) =
$self->add_closing_side_comment();
# Add or update any closing side comment
if ( $types_to_go[$max_index_to_go] eq '#' ) {
$ri_last->[-1] = $max_index_to_go;
}
} }
my $rindentation_list = [0]; # ref to indentations for each line my $rindentation_list = [0]; # ref to indentations for each line
# define the array @matching_token_to_go for the output tokens # define the array @{$ralignment_type_to_go} for the output tokens
# which will be non-blank for each special token (such as =>) # which will be non-blank for each special token (such as =>)
# for which alignment is required. # for which alignment is required.
set_vertical_alignment_markers( $ri_first, $ri_last ); my $ralignment_type_to_go =
$self->set_vertical_alignment_markers( $ri_first, $ri_last );
# flush if necessary to avoid unwanted alignment # flush before a long if statement to avoid unwanted alignment
my $must_flush = 0; if ( $n_last_line > 0
if ( @{$ri_first} > 1 ) { && $type_beg_next eq 'k'
&& $token_beg_next =~ /^(if|unless)$/ )
# flush before a long if statement {
if ( $types_to_go[0] eq 'k' && $tokens_to_go[0] =~ /^(if|unless)$/ ) {
$must_flush = 1;
}
}
if ($must_flush) {
Perl::Tidy::VerticalAligner::flush(); Perl::Tidy::VerticalAligner::flush();
} }
undo_ci( $ri_first, $ri_last ); $self->undo_ci( $ri_first, $ri_last );
set_logical_padding( $ri_first, $ri_last ); $self->set_logical_padding( $ri_first, $ri_last );
# loop to prepare each line for shipment # loop to prepare each line for shipment
my $n_last_line = @{$ri_first} - 1;
my $in_comma_list; my $in_comma_list;
my ( $Kbeg, $type_beg, $token_beg );
my ( $Kend, $type_end );
for my $n ( 0 .. $n_last_line ) { for my $n ( 0 .. $n_last_line ) {
my $ibeg = $ri_first->[$n];
my $iend = $ri_last->[$n];
delete_needless_alignments( $ibeg, $iend ); my $ibeg = $ri_first->[$n];
my $iend = $ri_last->[$n];
my ( $rtokens, $rfields, $rpatterns ) = my $rline = $rlines_K->[$n];
make_alignment_patterns( $ibeg, $iend ); my $forced_breakpoint = $rline->[2];
# we may need to look at variables on three consecutive lines ...
# Some vars on line [n-1], if any:
my $Kbeg_last = $Kbeg;
my $type_beg_last = $type_beg;
my $token_beg_last = $token_beg;
my $Kend_last = $Kend;
my $type_end_last = $type_end;
# Some vars on line [n]:
$Kbeg = $Kbeg_next;
$type_beg = $type_beg_next;
$token_beg = $token_beg_next;
$Kend = $Kend_next;
$type_end = $type_end_next;
# We use two slightly different definitions of level jump at the end
# of line:
# $ljump is the level jump needed by 'sub set_adjusted_indentation'
# $level_jump is the level jump needed by the vertical aligner.
my $ljump = 0; # level jump at end of line
# Set flag to show how much level changes between this line # Get some vars on line [n+1], if any:
# and the next line, if we have it.
my $ljump = 0;
if ( $n < $n_last_line ) { if ( $n < $n_last_line ) {
my $ibegp = $ri_first->[ $n + 1 ]; ( $Kbeg_next, $Kend_next ) =
$ljump = $levels_to_go[$ibegp] - $levels_to_go[$iend]; @{ $rlines_K->[ $n + 1 ] };
$type_beg_next = $rLL->[$Kbeg_next]->[_TYPE_];
$token_beg_next = $rLL->[$Kbeg_next]->[_TOKEN_];
$type_end_next = $rLL->[$Kend_next]->[_TYPE_];
$ljump = $rLL->[$Kbeg_next]->[_LEVEL_] - $rLL->[$Kend]->[_LEVEL_];
} }
# level jump at end of line for the vertical aligner:
my $level_jump =
$Kend >= $Klimit
? 0
: $rLL->[ $Kend + 1 ]->[_SLEVEL_] - $rLL->[$Kbeg]->[_SLEVEL_];
$self->delete_needless_alignments( $ibeg, $iend,
$ralignment_type_to_go );
my ( $rtokens, $rfields, $rpatterns ) =
$self->make_alignment_patterns( $ibeg, $iend,
$ralignment_type_to_go );
my ( $indentation, $lev, $level_end, $terminal_type, my ( $indentation, $lev, $level_end, $terminal_type,
$is_semicolon_terminated, $is_outdented_line ) $is_semicolon_terminated, $is_outdented_line )
= $self->set_adjusted_indentation( $ibeg, $iend, $rfields, $rpatterns, = $self->set_adjusted_indentation( $ibeg, $iend, $rfields, $rpatterns,
$ri_first, $ri_last, $rindentation_list, $ljump ); $ri_first, $ri_last, $rindentation_list, $ljump );
# we will allow outdenting of long lines.. # we will allow outdenting of long lines..
my $outdent_long_lines = ( my $outdent_long_lines = (
# which are long quotes, if allowed # which are long quotes, if allowed
( $types_to_go[$ibeg] eq 'Q' && $rOpts->{'outdent-long-quotes'} ) ( $type_beg eq 'Q' && $rOpts->{'outdent-long-quotes'} )
# which are long block comments, if allowed # which are long block comments, if allowed
|| ( || (
$types_to_go[$ibeg] eq '#' $type_beg eq '#'
&& $rOpts->{'outdent-long-comments'} && $rOpts->{'outdent-long-comments'}
# but not if this is a static block comment # but not if this is a static block comment
&& !$is_static_block_comment && !$is_static_block_comment
) )
); );
my $level_jump =
$nesting_depth_to_go[ $iend + 1 ] - $nesting_depth_to_go[$ibeg];
my $rvertical_tightness_flags = my $rvertical_tightness_flags =
set_vertical_tightness_flags( $n, $n_last_line, $ibeg, $iend, $self->set_vertical_tightness_flags( $n, $n_last_line, $ibeg, $iend,
$ri_first, $ri_last ); $ri_first, $ri_last );
# flush an outdented line to avoid any unwanted vertical alignment # flush an outdented line to avoid any unwanted vertical alignment
Perl::Tidy::VerticalAligner::flush() if ($is_outdented_line); Perl::Tidy::VerticalAligner::flush() if ($is_outdented_line);
# Set a flag at the final ':' of a ternary chain to request # Set a flag at the final ':' of a ternary chain to request
# vertical alignment of the final term. Here is a # vertical alignment of the final term. Here is a
# slightly complex example: # slightly complex example:
# #
# $self->{_text} = ( # $self->{_text} = (
skipping to change at line 10075 skipping to change at line 10096
# : $type eq 'item' ? "the $section entry" # : $type eq 'item' ? "the $section entry"
# : "the section on $section" # : "the section on $section"
# ) # )
# . ( # . (
# $page # $page
# ? ( $section ? ' in ' : '' ) . "the $page$page_ext manpage" # ? ( $section ? ' in ' : '' ) . "the $page$page_ext manpage"
# : ' elsewhere in this document' # : ' elsewhere in this document'
# ); # );
# #
my $is_terminal_ternary = 0; my $is_terminal_ternary = 0;
if ( $tokens_to_go[$ibeg] eq ':'
|| $n > 0 && $tokens_to_go[ $ri_last->[ $n - 1 ] ] eq ':' ) if ( $type_beg eq ':' || $n > 0 && $type_end_last eq ':' ) {
{ my $last_leading_type = $n > 0 ? $type_beg_last : ':';
my $last_leading_type = ":";
if ( $n > 0 ) {
my $iprev = $ri_first->[ $n - 1 ];
$last_leading_type = $types_to_go[$iprev];
}
if ( $terminal_type ne ';' if ( $terminal_type ne ';'
&& $n_last_line > $n && $n_last_line > $n
&& $level_end == $lev ) && $level_end == $lev )
{ {
my $inext = $ri_first->[ $n + 1 ]; $level_end = $rLL->[$Kbeg_next]->[_LEVEL_];
$level_end = $levels_to_go[$inext]; $terminal_type = $rLL->[$Kbeg_next]->[_TYPE_];
$terminal_type = $types_to_go[$inext]; }
} if (
$last_leading_type eq ':'
$is_terminal_ternary = $last_leading_type eq ':' && ( ( $terminal_type eq ';' && $level_end <= $lev )
&& ( ( $terminal_type eq ';' && $level_end <= $lev ) || ( $terminal_type ne ':' && $level_end < $lev ) )
|| ( $terminal_type ne ':' && $level_end < $lev ) ) )
{
# the terminal term must not contain any ternary terms, as in
# my $ECHO = ( # the terminal term must not contain any ternary terms, as in
# $Is_MSWin32 ? ".\\echo$$" # my $ECHO = (
# : $Is_MacOS ? ":echo$$" # $Is_MSWin32 ? ".\\echo$$"
# : ( $Is_NetWare ? "echo$$" : "./echo$$" ) # : $Is_MacOS ? ":echo$$"
# ); # : ( $Is_NetWare ? "echo$$" : "./echo$$" )
&& !grep { /^[\?\:]$/ } @types_to_go[ $ibeg + 1 .. $iend ]; # );
$is_terminal_ternary = 1;
my $KP = $rLL->[$Kbeg]->[_KNEXT_SEQ_ITEM_];
while ( defined($KP) && $KP <= $Kend ) {
my $type_KP = $rLL->[$KP]->[_TYPE_];
if ( $type_KP eq '?' || $type_KP eq ':' ) {
$is_terminal_ternary = 0;
last;
}
$KP = $rLL->[$KP]->[_KNEXT_SEQ_ITEM_];
}
}
} }
# send this new line down the pipe # add any new closing side comment to the last line
my $forced_breakpoint = $forced_breakpoint_to_go[$iend]; if ( $closing_side_comment && $n == $n_last_line && @{$rfields} ) {
$rfields->[-1] .= " $closing_side_comment";
}
# send this new line down the pipe
my $rvalign_hash = {}; my $rvalign_hash = {};
$rvalign_hash->{level} = $lev; $rvalign_hash->{level} = $lev;
$rvalign_hash->{level_end} = $level_end; $rvalign_hash->{level_end} = $level_end;
$rvalign_hash->{indentation} = $indentation; $rvalign_hash->{indentation} = $indentation;
$rvalign_hash->{is_forced_break} = $rvalign_hash->{is_forced_break} = $forced_breakpoint || $in_comma_list;
$forced_breakpoint_to_go[$iend] || $in_comma_list;
$rvalign_hash->{outdent_long_lines} = $outdent_long_lines; $rvalign_hash->{outdent_long_lines} = $outdent_long_lines;
$rvalign_hash->{is_terminal_ternary} = $is_terminal_ternary; $rvalign_hash->{is_terminal_ternary} = $is_terminal_ternary;
$rvalign_hash->{is_terminal_statement} = $is_semicolon_terminated; $rvalign_hash->{is_terminal_statement} = $is_semicolon_terminated;
$rvalign_hash->{do_not_pad} = $do_not_pad; $rvalign_hash->{do_not_pad} = $do_not_pad;
$rvalign_hash->{rvertical_tightness_flags} = $rvertical_tightness_flags; $rvalign_hash->{rvertical_tightness_flags} = $rvertical_tightness_flags;
$rvalign_hash->{level_jump} = $level_jump; $rvalign_hash->{level_jump} = $level_jump;
$rvalign_hash->{valign_batch_number} = $valign_batch_number; $rvalign_hash->{valign_batch_number} = $valign_batch_number;
Perl::Tidy::VerticalAligner::valign_input( $rvalign_hash, $rfields, Perl::Tidy::VerticalAligner::valign_input( $rvalign_hash, $rfields,
$rtokens, $rpatterns ); $rtokens, $rpatterns );
$in_comma_list = $in_comma_list = $type_end eq ',' && $forced_breakpoint;
$tokens_to_go[$iend] eq ',' && $forced_breakpoint_to_go[$iend];
# flush an outdented line to avoid any unwanted vertical alignment # flush an outdented line to avoid any unwanted vertical alignment
Perl::Tidy::VerticalAligner::flush() if ($is_outdented_line); Perl::Tidy::VerticalAligner::flush() if ($is_outdented_line);
$do_not_pad = 0; $do_not_pad = 0;
# Set flag indicating if this line ends in an opening # Set flag indicating if this line ends in an opening
# token and is very short, so that a blank line is not # token and is very short, so that a blank line is not
# needed if the subsequent line is a comment. # needed if the subsequent line is a comment.
# Examples of what we are looking for: # Examples of what we are looking for:
# { # {
# && ( # && (
# BEGIN { # BEGIN {
# default { # default {
# sub { # sub {
$last_output_short_opening_token $last_output_short_opening_token
# line ends in opening token # line ends in opening token
= $types_to_go[$iend] =~ /^[\{\(\[L]$/ = $type_end =~ /^[\{\(\[L]$/
# and either # and either
&& ( && (
# line has either single opening token # line has either single opening token
$iend == $ibeg $Kend == $Kbeg
# or is a single token followed by opening token. # or is a single token followed by opening token.
# Note that sub identifiers have blanks like 'sub doit' # Note that sub identifiers have blanks like 'sub doit'
|| ( $iend - $ibeg <= 2 && $tokens_to_go[$ibeg] !~ /\s+/ ) || ( $Kend - $Kbeg <= 2 && $token_beg !~ /\s+/ )
) )
# and limit total to 10 character widths # and limit total to 10 character widths
&& token_sequence_length( $ibeg, $iend ) <= 10; && token_sequence_length( $ibeg, $iend ) <= 10;
} # end of loop to output each line } # end of loop to output each line
# remember indentation of lines containing opening containers for # remember indentation of lines containing opening containers for
# later use by sub set_adjusted_indentation # later use by sub set_adjusted_indentation
save_opening_indentation( $ri_first, $ri_last, $rindentation_list ); $self->save_opening_indentation( $ri_first, $ri_last, $rindentation_list );
# output any new -cscw block comment # output any new -cscw block comment
if ($cscw_block_comment) { if ($cscw_block_comment) {
Perl::Tidy::VerticalAligner::flush(); Perl::Tidy::VerticalAligner::flush();
$file_writer_object->write_code_line( $cscw_block_comment . "\n" ); $file_writer_object->write_code_line( $cscw_block_comment . "\n" );
} }
return; return;
} }
{ # begin make_alignment_patterns { # begin make_alignment_patterns
skipping to change at line 10221 skipping to change at line 10250
%operator_map = ( %operator_map = (
'!~' => '=~', '!~' => '=~',
'+=' => '+=', '+=' => '+=',
'-=' => '+=', '-=' => '+=',
'*=' => '+=', '*=' => '+=',
'/=' => '+=', '/=' => '+=',
); );
} }
sub delete_needless_alignments { sub delete_needless_alignments {
my ( $ibeg, $iend ) = @_; my ( $self, $ibeg, $iend, $ralignment_type_to_go ) = @_;
# Remove unwanted alignments. This routine is a place to remove alignments # Remove unwanted alignments. This routine is a place to remove
# which might cause problems at later stages. There are currently # alignments which might cause problems at later stages. There are
# two types of fixes: # currently two types of fixes:
# 1. Remove excess parens # 1. Remove excess parens
# 2. Remove alignments within 'elsif' conditions # 2. Remove alignments within 'elsif' conditions
# Patch #1: Excess alignment of parens can prevent other good # Patch #1: Excess alignment of parens can prevent other good
# alignments. For example, note the parens in the first two rows of # alignments. For example, note the parens in the first two rows of
# the following snippet. They would normally get marked for alignment # the following snippet. They would normally get marked for alignment
# and aligned as follows: # and aligned as follows:
# my $w = $columns * $cell_w + ( $columns + 1 ) * $border; # my $w = $columns * $cell_w + ( $columns + 1 ) * $border;
skipping to change at line 10275 skipping to change at line 10304
# 'elsif' patch: remember the range of the parens of an elsif, # 'elsif' patch: remember the range of the parens of an elsif,
# and do not make alignments within them because this can cause # and do not make alignments within them because this can cause
# loss of padding and overall brace alignment in the vertical # loss of padding and overall brace alignment in the vertical
# aligner. # aligner.
if ( $tokens_to_go[$ibeg] eq 'elsif' if ( $tokens_to_go[$ibeg] eq 'elsif'
&& $i_good_paren < $iend && $i_good_paren < $iend
&& $tokens_to_go[$i_good_paren] eq '(' ) && $tokens_to_go[$i_good_paren] eq '(' )
{ {
$i_elsif_open = $i_good_paren; $i_elsif_open = $i_good_paren;
$i_elsif_close = $mate_index_to_go[$i_good_paren]; $i_elsif_close = $self->mate_index_to_go($i_good_paren);
} }
} }
} }
# Loop to make the fixes on this line # Loop to make the fixes on this line
my @imatch_list; my @imatch_list;
for my $i ( $ibeg .. $iend ) { for my $i ( $ibeg .. $iend ) {
if ( $matching_token_to_go[$i] ne '' ) { if ( $ralignment_type_to_go->[$i] ne '' ) {
# Patch #2: undo alignment within elsif parens # Patch #2: undo alignment within elsif parens
if ( $i > $i_elsif_open && $i < $i_elsif_close ) { if ( $i > $i_elsif_open && $i < $i_elsif_close ) {
$matching_token_to_go[$i] = ''; $ralignment_type_to_go->[$i] = '';
next; next;
} }
push @imatch_list, $i; push @imatch_list, $i;
} }
if ( $tokens_to_go[$i] eq ')' ) { if ( $tokens_to_go[$i] eq ')' ) {
# Patch #1: undo the corresponding opening paren if: # Patch #1: undo the corresponding opening paren if:
# - it is at the top of the stack # - it is at the top of the stack
# - and not the first overall opening paren # - and not the first overall opening paren
# - does not follow a leading keyword on this line # - does not follow a leading keyword on this line
my $imate = $mate_index_to_go[$i]; my $imate = $self->mate_index_to_go($i);
if ( @imatch_list if ( @imatch_list
&& $imatch_list[-1] eq $imate && $imatch_list[-1] eq $imate
&& ( $ibeg > 1 || @imatch_list > 1 ) && ( $ibeg > 1 || @imatch_list > 1 )
&& $imate > $i_good_paren ) && $imate > $i_good_paren )
{ {
$matching_token_to_go[$imate] = ''; $ralignment_type_to_go->[$imate] = '';
pop @imatch_list; pop @imatch_list;
} }
} }
} }
return; return;
} }
sub make_alignment_patterns { sub make_alignment_patterns {
# Here we do some important preliminary work for the # Here we do some important preliminary work for the
skipping to change at line 10335 skipping to change at line 10364
# These are tokens, such as '=' '&&' '#' etc which # These are tokens, such as '=' '&&' '#' etc which
# we want to might align vertically. These are # we want to might align vertically. These are
# decorated with various information such as # decorated with various information such as
# nesting depth to prevent unwanted vertical # nesting depth to prevent unwanted vertical
# alignment matches. # alignment matches.
# @fields - the actual text of the line between the vertical alignment # @fields - the actual text of the line between the vertical alignment
# tokens. # tokens.
# @patterns - a modified list of token types, one for each alignment # @patterns - a modified list of token types, one for each alignment
# field. These should normally each match before alignment is # field. These should normally each match before alignment is
# allowed, even when the alignment tokens match. # allowed, even when the alignment tokens match.
my ( $ibeg, $iend ) = @_; my ( $self, $ibeg, $iend, $ralignment_type_to_go ) = @_;
my @tokens = (); my @tokens = ();
my @fields = (); my @fields = ();
my @patterns = (); my @patterns = ();
my $i_start = $ibeg; my $i_start = $ibeg;
my $depth = 0; my $depth = 0;
my @container_name = (""); my @container_name = ("");
my @multiple_comma_arrows = (undef); my @multiple_comma_arrows = (undef);
my $j = 0; # field index my $j = 0; # field index
skipping to change at line 10359 skipping to change at line 10388
for my $i ( $ibeg .. $iend ) { for my $i ( $ibeg .. $iend ) {
# Keep track of containers balanced on this line only. # Keep track of containers balanced on this line only.
# These are used below to prevent unwanted cross-line alignments. # These are used below to prevent unwanted cross-line alignments.
# Unbalanced containers already avoid aligning across # Unbalanced containers already avoid aligning across
# container boundaries. # container boundaries.
my $tok = $tokens_to_go[$i]; my $tok = $tokens_to_go[$i];
if ( $tok =~ /^[\(\{\[]/ ) { #'(' ) { if ( $tok =~ /^[\(\{\[]/ ) { #'(' ) {
# if container is balanced on this line... # if container is balanced on this line...
my $i_mate = $mate_index_to_go[$i]; my $i_mate = $self->mate_index_to_go($i);
if ( $i_mate > $i && $i_mate <= $iend ) { if ( $i_mate > $i && $i_mate <= $iend ) {
$depth++; $depth++;
my $seqno = $type_sequence_to_go[$i]; my $seqno = $type_sequence_to_go[$i];
my $count = comma_arrow_count($seqno); my $count = comma_arrow_count($seqno);
$multiple_comma_arrows[$depth] = $count && $count > 1; $multiple_comma_arrows[$depth] = $count && $count > 1;
# Append the previous token name to make the container name # Append the previous token name to make the container name
# more unique. This name will also be given to any commas # more unique. This name will also be given to any commas
# within this container, and it helps avoid undesirable # within this container, and it helps avoid undesirable
# alignments of different types of containers. # alignments of different types of containers.
skipping to change at line 10416 skipping to change at line 10445
# glVertex3d( $cx - $s * $xs, $cy, $z ); # glVertex3d( $cx - $s * $xs, $cy, $z );
# glVertex3d( $cx, $cy - $s * $ys, $z ); # glVertex3d( $cx, $cy - $s * $ys, $z );
# #
# To distinguish between these situations, we will # To distinguish between these situations, we will
# append the length of the line from the previous matching # append the length of the line from the previous matching
# token, or beginning of line, to the function name. This # token, or beginning of line, to the function name. This
# will allow the vertical aligner to reject undesirable # will allow the vertical aligner to reject undesirable
# matches. # matches.
# if we are not aligning on this paren... # if we are not aligning on this paren...
if ( $matching_token_to_go[$i] eq '' ) { if ( $ralignment_type_to_go->[$i] eq '' ) {
# Sum length from previous alignment # Sum length from previous alignment
my $len = token_sequence_length( $i_start, $i - 1 ); my $len = token_sequence_length( $i_start, $i - 1 );
if ( $i_start == $ibeg ) { if ( $i_start == $ibeg ) {
# For first token, use distance from start of line # For first token, use distance from start of line
# but subtract off the indentation due to level. # but subtract off the indentation due to level.
# Otherwise, results could vary with indentation. # Otherwise, results could vary with indentation.
$len += leading_spaces_to_go($ibeg) - $len += leading_spaces_to_go($ibeg) -
$levels_to_go[$i_start] * $rOpts_indent_columns; $levels_to_go[$i_start] * $rOpts_indent_columns;
skipping to change at line 10442 skipping to change at line 10471
$container_name[$depth] .= "-" . $len; $container_name[$depth] .= "-" . $len;
} }
} }
} }
elsif ( $tokens_to_go[$i] =~ /^[\)\}\]]/ ) { elsif ( $tokens_to_go[$i] =~ /^[\)\}\]]/ ) {
$depth-- if $depth > 0; $depth-- if $depth > 0;
} }
# if we find a new synchronization token, we are done with # if we find a new synchronization token, we are done with
# a field # a field
if ( $i > $i_start && $matching_token_to_go[$i] ne '' ) { if ( $i > $i_start && $ralignment_type_to_go->[$i] ne '' ) {
my $tok = my $raw_tok = $matching_token_to_go[$i]; my $tok = my $raw_tok = $ralignment_type_to_go->[$i];
# map similar items # map similar items
my $tok_map = $operator_map{$tok}; my $tok_map = $operator_map{$tok};
$tok = $tok_map if ($tok_map); $tok = $tok_map if ($tok_map);
# make separators in different nesting depths unique # make separators in different nesting depths unique
# by appending the nesting depth digit. # by appending the nesting depth digit.
if ( $raw_tok ne '#' ) { if ( $raw_tok ne '#' ) {
$tok .= "$nesting_depth_to_go[$i]"; $tok .= "$nesting_depth_to_go[$i]";
} }
skipping to change at line 10682 skipping to change at line 10711
} }
return $comma_arrow_count_contained; return $comma_arrow_count_contained;
} }
sub save_opening_indentation { sub save_opening_indentation {
# This should be called after each batch of tokens is output. It # This should be called after each batch of tokens is output. It
# saves indentations of lines of all unmatched opening tokens. # saves indentations of lines of all unmatched opening tokens.
# These will be used by sub get_opening_indentation. # These will be used by sub get_opening_indentation.
my ( $ri_first, $ri_last, $rindentation_list ) = @_; my ( $self, $ri_first, $ri_last, $rindentation_list ) = @_;
# we no longer need indentations of any saved indentations which # we no longer need indentations of any saved indentations which
# are unmatched closing tokens in this batch, because we will # are unmatched closing tokens in this batch, because we will
# never encounter them again. So we can delete them to keep # never encounter them again. So we can delete them to keep
# the hash size down. # the hash size down.
foreach (@unmatched_closing_indexes_in_this_batch) { foreach (@unmatched_closing_indexes_in_this_batch) {
my $seqno = $type_sequence_to_go[$_]; my $seqno = $type_sequence_to_go[$_];
delete $saved_opening_indentation{$seqno}; delete $saved_opening_indentation{$seqno};
} }
skipping to change at line 10727 skipping to change at line 10756
# $ri_last - reference to list of the last index $i for each output line # $ri_last - reference to list of the last index $i for each output line
# in this batch # in this batch
# $rindentation_list - reference to a list containing the indentation # $rindentation_list - reference to a list containing the indentation
# used for each line. # used for each line.
# #
# return: # return:
# -the indentation of the line which contained the opening token # -the indentation of the line which contained the opening token
# which matches the token at index $i_opening # which matches the token at index $i_opening
# -and its offset (number of columns) from the start of the line # -and its offset (number of columns) from the start of the line
# #
my ( $i_closing, $ri_first, $ri_last, $rindentation_list ) = @_; my ( $self, $i_closing, $ri_first, $ri_last, $rindentation_list ) = @_;
# first, see if the opening token is in the current batch # first, see if the opening token is in the current batch
my $i_opening = $mate_index_to_go[$i_closing]; my $i_opening = $mate_index_to_go[$i_closing];
my ( $indent, $offset, $is_leading, $exists ); my ( $indent, $offset, $is_leading, $exists );
$exists = 1; $exists = 1;
if ( $i_opening >= 0 ) { if ( $i_opening >= 0 ) {
# it is..look up the indentation # it is..look up the indentation
( $indent, $offset, $is_leading ) = ( $indent, $offset, $is_leading ) =
lookup_opening_indentation( $i_opening, $ri_first, $ri_last, lookup_opening_indentation( $i_opening, $ri_first, $ri_last,
skipping to change at line 10794 skipping to change at line 10823
# used for each line. (NOTE: the first slot in # used for each line. (NOTE: the first slot in
# this list is the last returned line number, and this is # this list is the last returned line number, and this is
# followed by the list of indentations). # followed by the list of indentations).
# #
# return # return
# -the indentation of the line which contained token $i_opening # -the indentation of the line which contained token $i_opening
# -and its offset (number of columns) from the start of the line # -and its offset (number of columns) from the start of the line
my ( $i_opening, $ri_start, $ri_last, $rindentation_list ) = @_; my ( $i_opening, $ri_start, $ri_last, $rindentation_list ) = @_;
if ( !@{$ri_last} ) {
warning("Error in opening_indentation: no lines");
return;
}
my $nline = $rindentation_list->[0]; # line number of previous lookup my $nline = $rindentation_list->[0]; # line number of previous lookup
# reset line location if necessary # reset line location if necessary
$nline = 0 if ( $i_opening < $ri_start->[$nline] ); $nline = 0 if ( $i_opening < $ri_start->[$nline] );
# find the correct line # find the correct line
unless ( $i_opening > $ri_last->[-1] ) { unless ( $i_opening > $ri_last->[-1] ) {
while ( $i_opening > $ri_last->[$nline] ) { $nline++; } while ( $i_opening > $ri_last->[$nline] ) { $nline++; }
} }
skipping to change at line 10853 skipping to change at line 10887
my ( my (
$self, $ibeg, $iend, $self, $ibeg, $iend,
$rfields, $rpatterns, $ri_first, $rfields, $rpatterns, $ri_first,
$ri_last, $rindentation_list, $level_jump $ri_last, $rindentation_list, $level_jump
) = @_; ) = @_;
my $rLL = $self->{rLL}; my $rLL = $self->{rLL};
# we need to know the last token of this line # we need to know the last token of this line
my ( $terminal_type, $i_terminal ) = my ( $terminal_type, $i_terminal ) =
terminal_type( \@types_to_go, \@block_type_to_go, $ibeg, $iend ); $self->terminal_type_i( $ibeg, $iend );
my $is_outdented_line = 0; my $is_outdented_line = 0;
my $is_semicolon_terminated = $terminal_type eq ';' my $is_semicolon_terminated = $terminal_type eq ';'
&& $nesting_depth_to_go[$iend] < $nesting_depth_to_go[$ibeg]; && $nesting_depth_to_go[$iend] < $nesting_depth_to_go[$ibeg];
# NOTE: A future improvement would be to make it semicolon terminated # NOTE: A future improvement would be to make it semicolon terminated
# even if it does not have a semicolon but is followed by a closing # even if it does not have a semicolon but is followed by a closing
# block brace. This would undo ci even for something like the # block brace. This would undo ci even for something like the
# following, in which the final paren does not have a semicolon because # following, in which the final paren does not have a semicolon because
skipping to change at line 10942 skipping to change at line 10976
# if we are at a closing token of some type.. # if we are at a closing token of some type..
if ( $type_beg =~ /^[\)\}\]R]$/ ) { if ( $type_beg =~ /^[\)\}\]R]$/ ) {
# get the indentation of the line containing the corresponding # get the indentation of the line containing the corresponding
# opening token # opening token
( (
$opening_indentation, $opening_offset, $opening_indentation, $opening_offset,
$is_leading, $opening_exists $is_leading, $opening_exists
) )
= get_opening_indentation( $ibeg_weld_fix, $ri_first, $ri_last, = $self->get_opening_indentation( $ibeg_weld_fix, $ri_first,
$rindentation_list ); $ri_last, $rindentation_list );
# First set the default behavior: # First set the default behavior:
if ( if (
# default behavior is to outdent closing lines # default behavior is to outdent closing lines
# of the form: "); }; ]; )->xxx;" # of the form: "); }; ]; )->xxx;"
$is_semicolon_terminated $is_semicolon_terminated
# and 'cuddled parens' of the form: ")->pack(" # and 'cuddled parens' of the form: ")->pack("
# Bug fix for RT #123749]: the types here were # Bug fix for RT #123749]: the types here were
skipping to change at line 11041 skipping to change at line 11075
# we see if we are in a list, and this works well. # we see if we are in a list, and this works well.
# See test files 'sub*.t' for good test cases. # See test files 'sub*.t' for good test cases.
if ( $block_type_to_go[$ibeg] =~ /$ASUB_PATTERN/ if ( $block_type_to_go[$ibeg] =~ /$ASUB_PATTERN/
&& $container_environment_to_go[$i_terminal] eq 'LIST' && $container_environment_to_go[$i_terminal] eq 'LIST'
&& !$rOpts->{'indent-closing-brace'} ) && !$rOpts->{'indent-closing-brace'} )
{ {
( (
$opening_indentation, $opening_offset, $opening_indentation, $opening_offset,
$is_leading, $opening_exists $is_leading, $opening_exists
) )
= get_opening_indentation( $ibeg, $ri_first, $ri_last, = $self->get_opening_indentation( $ibeg, $ri_first,
$rindentation_list ); $ri_last, $rindentation_list );
my $indentation = $leading_spaces_to_go[$ibeg]; my $indentation = $leading_spaces_to_go[$ibeg];
if ( defined($opening_indentation) if ( defined($opening_indentation)
&& get_spaces($indentation) > && get_spaces($indentation) >
get_spaces($opening_indentation) ) get_spaces($opening_indentation) )
{ {
$adjust_indentation = 1; $adjust_indentation = 1;
} }
} }
} }
skipping to change at line 11065 skipping to change at line 11099
# but not beyond the indention of the line with # but not beyond the indention of the line with
# the opening brace. # the opening brace.
if ( $block_type_to_go[$ibeg] eq 'eval' if ( $block_type_to_go[$ibeg] eq 'eval'
&& !$rOpts->{'line-up-parentheses'} && !$rOpts->{'line-up-parentheses'}
&& !$rOpts->{'indent-closing-brace'} ) && !$rOpts->{'indent-closing-brace'} )
{ {
( (
$opening_indentation, $opening_offset, $opening_indentation, $opening_offset,
$is_leading, $opening_exists $is_leading, $opening_exists
) )
= get_opening_indentation( $ibeg, $ri_first, $ri_last, = $self->get_opening_indentation( $ibeg, $ri_first, $ri_last,
$rindentation_list ); $rindentation_list );
my $indentation = $leading_spaces_to_go[$ibeg]; my $indentation = $leading_spaces_to_go[$ibeg];
if ( defined($opening_indentation) if ( defined($opening_indentation)
&& get_spaces($indentation) > && get_spaces($indentation) >
get_spaces($opening_indentation) ) get_spaces($opening_indentation) )
{ {
$adjust_indentation = 1; $adjust_indentation = 1;
} }
} }
skipping to change at line 11140 skipping to change at line 11174
} }
} }
# if line begins with a ':', align it with any # if line begins with a ':', align it with any
# previous line leading with corresponding ? # previous line leading with corresponding ?
elsif ( $types_to_go[$ibeg] eq ':' ) { elsif ( $types_to_go[$ibeg] eq ':' ) {
( (
$opening_indentation, $opening_offset, $opening_indentation, $opening_offset,
$is_leading, $opening_exists $is_leading, $opening_exists
) )
= get_opening_indentation( $ibeg, $ri_first, $ri_last, = $self->get_opening_indentation( $ibeg, $ri_first, $ri_last,
$rindentation_list ); $rindentation_list );
if ($is_leading) { $adjust_indentation = 2; } if ($is_leading) { $adjust_indentation = 2; }
} }
########################################################## ##########################################################
# Section 2: set indentation according to flag set above # Section 2: set indentation according to flag set above
# #
# Select the indentation object to define leading # Select the indentation object to define leading
# whitespace. If we are outdenting something like '} } );' # whitespace. If we are outdenting something like '} } );'
# then we want to use one level below the last token # then we want to use one level below the last token
skipping to change at line 11323 skipping to change at line 11357
$last_leading_token = $tokens_to_go[$ibeg]; $last_leading_token = $tokens_to_go[$ibeg];
} }
# be sure lines with leading closing tokens are not outdented more # be sure lines with leading closing tokens are not outdented more
# than the line which contained the corresponding opening token. # than the line which contained the corresponding opening token.
############################################################# #############################################################
# updated per bug report in alex_bug.pl: we must not # updated per bug report in alex_bug.pl: we must not
# mess with the indentation of closing logical braces so # mess with the indentation of closing logical braces so
# we must treat something like '} else {' as if it were # we must treat something like '} else {' as if it were
# an isolated brace my $is_isolated_block_brace = ( # an isolated brace
# $iend == $ibeg ) && $block_type_to_go[$ibeg];
############################################################# #############################################################
my $is_isolated_block_brace = $block_type_to_go[$ibeg] my $is_isolated_block_brace = $block_type_to_go[$ibeg]
&& ( $iend == $ibeg && ( $i_terminal == $ibeg
|| $is_if_elsif_else_unless_while_until_for_foreach{ || $is_if_elsif_else_unless_while_until_for_foreach{
$block_type_to_go[$ibeg] $block_type_to_go[$ibeg]
} ); } );
# only do this for a ':; which is aligned with its leading '?' # only do this for a ':; which is aligned with its leading '?'
my $is_unaligned_colon = $types_to_go[$ibeg] eq ':' && !$is_leading; my $is_unaligned_colon = $types_to_go[$ibeg] eq ':' && !$is_leading;
if ( if (
defined($opening_indentation) defined($opening_indentation)
&& !$leading_paren_arrow # MOJO && !$leading_paren_arrow # MOJO
skipping to change at line 11405 skipping to change at line 11438
$indentation = $space_count; $indentation = $space_count;
} }
} }
} }
return ( $indentation, $lev, $level_end, $terminal_type, return ( $indentation, $lev, $level_end, $terminal_type,
$is_semicolon_terminated, $is_outdented_line ); $is_semicolon_terminated, $is_outdented_line );
} }
} }
sub mate_index_to_go {
my ( $self, $i ) = @_;
# Return the matching index of a container or ternary pair
# This is equivalent to the array @mate_index_to_go
my $K = $K_to_go[$i];
my $K_mate = $self->K_mate_index($K);
my $i_mate = -1;
if ( defined($K_mate) ) {
$i_mate = $i + ( $K_mate - $K );
if ( $i_mate < 0 || $i_mate > $max_index_to_go ) {
$i_mate = -1;
}
}
my $i_mate_alt = $mate_index_to_go[$i];
# Debug code to eventually be removed
if ( 0 && $i_mate_alt != $i_mate ) {
my $tok = $tokens_to_go[$i];
my $type = $types_to_go[$i];
my $tok_mate = '*';
my $type_mate = '*';
if ( $i_mate >= 0 && $i_mate <= $max_index_to_go ) {
$tok_mate = $tokens_to_go[$i_mate];
$type_mate = $types_to_go[$i_mate];
}
my $seq = $type_sequence_to_go[$i];
my $file = $logger_object->get_input_stream_name();
Warn(
"mate_index: file '$file': i=$i, imate=$i_mate, should be $i_mate_alt, K=$K, K_m
ate=$K_mate\ntype=$type, tok=$tok, seq=$seq, max=$max_index_to_go, tok_mate=$tok
_mate, type_mate=$type_mate"
);
}
return $i_mate;
}
sub K_mate_index {
# Given the index K of an opening or closing container, or ?/: ternary pair,
# return the index K of the other member of the pair.
my ( $self, $K ) = @_;
return unless defined($K);
my $rLL = $self->{rLL};
my $seqno = $rLL->[$K]->[_TYPE_SEQUENCE_];
return unless ($seqno);
my $K_opening = $self->{K_opening_container}->{$seqno};
if ( defined($K_opening) ) {
if ( $K != $K_opening ) { return $K_opening }
return $self->{K_closing_container}->{$seqno};
}
$K_opening = $self->{K_opening_ternary}->{$seqno};
if ( defined($K_opening) ) {
if ( $K != $K_opening ) { return $K_opening }
return $self->{K_closing_ternary}->{$seqno};
}
return;
}
sub set_vertical_tightness_flags { sub set_vertical_tightness_flags {
my ( $n, $n_last_line, $ibeg, $iend, $ri_first, $ri_last ) = @_; my ( $self, $n, $n_last_line, $ibeg, $iend, $ri_first, $ri_last ) = @_;
# Define vertical tightness controls for the nth line of a batch. # Define vertical tightness controls for the nth line of a batch.
# We create an array of parameters which tell the vertical aligner # We create an array of parameters which tell the vertical aligner
# if we should combine this line with the next line to achieve the # if we should combine this line with the next line to achieve the
# desired vertical tightness. The array of parameters contains: # desired vertical tightness. The array of parameters contains:
# #
# [0] type: 1=opening non-block 2=closing non-block # [0] type: 1=opening non-block 2=closing non-block
# 3=opening block brace 4=closing block brace # 3=opening block brace 4=closing block brace
# #
# [1] flag: if opening: 1=no multiple steps, 2=multiple steps ok # [1] flag: if opening: 1=no multiple steps, 2=multiple steps ok
skipping to change at line 11611 skipping to change at line 11704
{ {
$stackable = $stack_opening_token{$token_beg_next} $stackable = $stack_opening_token{$token_beg_next}
unless ( $block_type_to_go[$ibeg_next] ) unless ( $block_type_to_go[$ibeg_next] )
; # shouldn't happen; just checking ; # shouldn't happen; just checking
} }
if ($stackable) { if ($stackable) {
my $is_semicolon_terminated; my $is_semicolon_terminated;
if ( $n + 1 == $n_last_line ) { if ( $n + 1 == $n_last_line ) {
my ( $terminal_type, $i_terminal ) = terminal_type( my ( $terminal_type, $i_terminal ) =
\@types_to_go, \@block_type_to_go, $self->terminal_type_i( $ibeg_next, $iend_next );
$ibeg_next, $iend_next
);
$is_semicolon_terminated = $terminal_type eq ';' $is_semicolon_terminated = $terminal_type eq ';'
&& $nesting_depth_to_go[$iend_next] < && $nesting_depth_to_go[$iend_next] <
$nesting_depth_to_go[$ibeg_next]; $nesting_depth_to_go[$ibeg_next];
} }
# this must be a line with just an opening token # this must be a line with just an opening token
# or end in a semicolon # or end in a semicolon
if ( if (
$is_semicolon_terminated $is_semicolon_terminated
|| ( $iend_next == $ibeg_next || ( $iend_next == $ibeg_next
skipping to change at line 11739 skipping to change at line 11830
@is_vertical_alignment_keyword{@q} = (1) x scalar(@q); @is_vertical_alignment_keyword{@q} = (1) x scalar(@q);
} }
sub set_vertical_alignment_markers { sub set_vertical_alignment_markers {
# This routine takes the first step toward vertical alignment of the # This routine takes the first step toward vertical alignment of the
# lines of output text. It looks for certain tokens which can serve as # lines of output text. It looks for certain tokens which can serve as
# vertical alignment markers (such as an '='). # vertical alignment markers (such as an '=').
# #
# Method: We look at each token $i in this output batch and set # Method: We look at each token $i in this output batch and set
# $matching_token_to_go[$i] equal to those tokens at which we would # $ralignment_type_to_go->[$i] equal to those tokens at which we would
# accept vertical alignment. # accept vertical alignment.
my ( $ri_first, $ri_last ) = @_; my ( $self, $ri_first, $ri_last ) = @_;
my $ralignment_type_to_go;
for my $i ( 0 .. $max_index_to_go ) {
$ralignment_type_to_go->[$i] = '';
}
# nothing to do if we aren't allowed to change whitespace # nothing to do if we aren't allowed to change whitespace
if ( !$rOpts_add_whitespace ) { if ( !$rOpts_add_whitespace ) {
for my $i ( 0 .. $max_index_to_go ) { return $ralignment_type_to_go;
$matching_token_to_go[$i] = '';
}
return;
} }
# remember the index of last nonblank token before any sidecomment # remember the index of last nonblank token before any sidecomment
my $i_terminal = $max_index_to_go; my $i_terminal = $max_index_to_go;
if ( $types_to_go[$i_terminal] eq '#' ) { if ( $types_to_go[$i_terminal] eq '#' ) {
if ( $i_terminal > 0 && $types_to_go[ --$i_terminal ] eq 'b' ) { if ( $i_terminal > 0 && $types_to_go[ --$i_terminal ] eq 'b' ) {
if ( $i_terminal > 0 ) { --$i_terminal } if ( $i_terminal > 0 ) { --$i_terminal }
} }
} }
skipping to change at line 11783 skipping to change at line 11876
$vert_last_nonblank_block_type = ''; $vert_last_nonblank_block_type = '';
# look at each token in this output line.. # look at each token in this output line..
my $level_beg = $levels_to_go[$ibeg]; my $level_beg = $levels_to_go[$ibeg];
foreach my $i ( $ibeg .. $iend ) { foreach my $i ( $ibeg .. $iend ) {
my $alignment_type = ''; my $alignment_type = '';
my $type = $types_to_go[$i]; my $type = $types_to_go[$i];
my $block_type = $block_type_to_go[$i]; my $block_type = $block_type_to_go[$i];
my $token = $tokens_to_go[$i]; my $token = $tokens_to_go[$i];
# check for flag indicating that we should not align
# this token
if ( $matching_token_to_go[$i] ) {
$matching_token_to_go[$i] = '';
next;
}
# do not align tokens at lower level then start of line # do not align tokens at lower level then start of line
# except for side comments # except for side comments
if ( $levels_to_go[$i] < $levels_to_go[$ibeg] if ( $levels_to_go[$i] < $levels_to_go[$ibeg]
&& $types_to_go[$i] ne '#' ) && $types_to_go[$i] ne '#' )
{ {
$matching_token_to_go[$i] = ''; $ralignment_type_to_go->[$i] = '';
next; next;
} }
#-------------------------------------------------------- #--------------------------------------------------------
# First see if we want to align BEFORE this token # First see if we want to align BEFORE this token
#-------------------------------------------------------- #--------------------------------------------------------
# The first possible token that we can align before # The first possible token that we can align before
# is index 2 because: 1) it doesn't normally make sense to # is index 2 because: 1) it doesn't normally make sense to
# align before the first token and 2) the second # align before the first token and 2) the second
skipping to change at line 11960 skipping to change at line 12046
# then go ahead and align # then go ahead and align
) )
{ {
$alignment_type = $vert_last_nonblank_type; $alignment_type = $vert_last_nonblank_type;
} }
#-------------------------------------------------------- #--------------------------------------------------------
# then store the value # then store the value
#-------------------------------------------------------- #--------------------------------------------------------
$matching_token_to_go[$i] = $alignment_type; $ralignment_type_to_go->[$i] = $alignment_type;
if ( $type ne 'b' ) { if ( $type ne 'b' ) {
$vert_last_nonblank_type = $type; $vert_last_nonblank_type = $type;
$vert_last_nonblank_token = $token; $vert_last_nonblank_token = $token;
$vert_last_nonblank_block_type = $block_type; $vert_last_nonblank_block_type = $block_type;
} }
} }
} }
return; return $ralignment_type_to_go;
} }
} }
sub terminal_type { sub terminal_type_i {
# returns type of last token on this line (terminal token), as follows: # returns type of last token on this line (terminal token), as follows:
# returns # for a full-line comment # returns # for a full-line comment
# returns ' ' for a blank line # returns ' ' for a blank line
# otherwise returns final token type # otherwise returns final token type
my ( $rtype, $rblock_type, $ibeg, $iend ) = @_; my ( $self, $ibeg, $iend ) = @_;
# Start at the end and work backwards
my $i = $iend;
my $type_i = $types_to_go[$i];
# check for full-line comment.. # Check for side comment
if ( $rtype->[$ibeg] eq '#' ) { if ( $type_i eq '#' ) {
return wantarray ? ( $rtype->[$ibeg], $ibeg ) : $rtype->[$ibeg]; $i--;
if ( $i < $ibeg ) {
return wantarray ? ( $type_i, $ibeg ) : $type_i;
}
$type_i = $types_to_go[$i];
}
# Skip past a blank
if ( $type_i eq 'b' ) {
$i--;
if ( $i < $ibeg ) {
return wantarray ? ( $type_i, $ibeg ) : $type_i;
}
$type_i = $types_to_go[$i];
} }
else {
# start at end and walk backwards.. # Found it..make sure it is a BLOCK termination,
for ( my $i = $iend ; $i >= $ibeg ; $i-- ) { # but hide a terminal } after sort/grep/map because it is not
# necessarily the end of the line. (terminal.t)
my $block_type = $block_type_to_go[$i];
if (
$type_i eq '}'
&& ( !$block_type
|| ( $is_sort_map_grep_eval_do{$block_type} ) )
)
{
$type_i = 'b';
}
return wantarray ? ( $type_i, $i ) : $type_i;
}
# skip past any side comment and blanks sub terminal_type_K {
next if ( $rtype->[$i] eq 'b' );
next if ( $rtype->[$i] eq '#' ); # returns type of last token on this line (terminal token), as follows:
# returns # for a full-line comment
# found it..make sure it is a BLOCK termination, # returns ' ' for a blank line
# but hide a terminal } after sort/grep/map because it is not # otherwise returns final token type
# necessarily the end of the line. (terminal.t)
my $terminal_type = $rtype->[$i]; my ( $self, $Kbeg, $Kend ) = @_;
if ( my $rLL = $self->{rLL};
$terminal_type eq '}'
&& ( !$rblock_type->[$i] if ( !defined($Kend) ) {
|| ( $is_sort_map_grep_eval_do{ $rblock_type->[$i] } ) ) Fault("Error in terminal_type_K: Kbeg=$Kbeg > $Kend=Kend");
) }
{
$terminal_type = 'b'; # Start at the end and work backwards
} my $K = $Kend;
return wantarray ? ( $terminal_type, $i ) : $terminal_type; my $type_K = $rLL->[$K]->[_TYPE_];
# Check for side comment
if ( $type_K eq '#' ) {
$K--;
if ( $K < $Kbeg ) {
return wantarray ? ( $type_K, $Kbeg ) : $type_K;
}
$type_K = $rLL->[$K]->[_TYPE_];
}
# Skip past a blank
if ( $type_K eq 'b' ) {
$K--;
if ( $K < $Kbeg ) {
return wantarray ? ( $type_K, $Kbeg ) : $type_K;
} }
$type_K = $rLL->[$K]->[_TYPE_];
}
# empty line # found it..make sure it is a BLOCK termination,
return wantarray ? ( ' ', $ibeg ) : ' '; # but hide a terminal } after sort/grep/map because it is not
# necessarily the end of the line. (terminal.t)
my $block_type = $rLL->[$K]->[_BLOCK_TYPE_];
if (
$type_K eq '}'
&& ( !$block_type
|| ( $is_sort_map_grep_eval_do{$block_type} ) )
)
{
$type_K = 'b';
} }
return wantarray ? ( $type_K, $K ) : $type_K;
} }
{ # set_bond_strengths { # set_bond_strengths
my %is_good_keyword_breakpoint; my %is_good_keyword_breakpoint;
my %is_lt_gt_le_ge; my %is_lt_gt_le_ge;
my %binary_bond_strength; my %binary_bond_strength;
my %nobreak_lhs; my %nobreak_lhs;
my %nobreak_rhs; my %nobreak_rhs;
skipping to change at line 14744 skipping to change at line 14886
# This is a no-brainer, just break at the comma. # This is a no-brainer, just break at the comma.
if ( if (
$rOpts_line_up_parentheses # -lp $rOpts_line_up_parentheses # -lp
&& $item_count == 2 # two items, one comma && $item_count == 2 # two items, one comma
&& !$must_break_open && !$must_break_open
) )
{ {
my $i_break = $rcomma_index->[0]; my $i_break = $rcomma_index->[0];
set_forced_breakpoint($i_break); set_forced_breakpoint($i_break);
${$rdo_not_break_apart} = 1; ${$rdo_not_break_apart} = 1;
set_non_alignment_flags( $comma_count, $rcomma_index );
return; return;
} }
# method 2 is for most small ragged lists which might look # method 2 is for most small ragged lists which might look
# best if not displayed as a table. # best if not displayed as a table.
if ( if (
( $number_of_fields == 2 && $item_count == 3 ) ( $number_of_fields == 2 && $item_count == 3 )
|| ( || (
$new_identifier_count > 0 # isn't all quotes $new_identifier_count > 0 # isn't all quotes
skipping to change at line 14777 skipping to change at line 14918
unless ($must_break_open) { unless ($must_break_open) {
if ( $break_count <= 1 ) { if ( $break_count <= 1 ) {
${$rdo_not_break_apart} = 1; ${$rdo_not_break_apart} = 1;
} }
elsif ( $rOpts_line_up_parentheses && !$need_lp_break_open ) elsif ( $rOpts_line_up_parentheses && !$need_lp_break_open )
{ {
${$rdo_not_break_apart} = 1; ${$rdo_not_break_apart} = 1;
} }
} }
set_non_alignment_flags( $comma_count, $rcomma_index );
return; return;
} }
} # end shortcut methods } # end shortcut methods
# debug stuff # debug stuff
FORMATTER_DEBUG_FLAG_SPARSE && do { FORMATTER_DEBUG_FLAG_SPARSE && do {
print STDOUT print STDOUT
"SPARSE:cols=$columns commas=$comma_count items:$item_count ids=$identifier_coun t pairwidth=$pair_width fields=$number_of_fields lines packed: $packed_lines pac ked_cols=$packed_columns fmtd:$formatted_lines cols /line:$columns_per_line unu sed:$unused_columns fmtd:$formatted_columns sparsity=$sparsity allow=$max_allowe d_sparsity\n"; "SPARSE:cols=$columns commas=$comma_count items:$item_count ids=$identifier_coun t pairwidth=$pair_width fields=$number_of_fields lines packed: $packed_lines pac ked_cols=$packed_columns fmtd:$formatted_lines cols /line:$columns_per_line unu sed:$unused_columns fmtd:$formatted_columns sparsity=$sparsity allow=$max_allowe d_sparsity\n";
skipping to change at line 14877 skipping to change at line 15017
unless ($must_break_open_container) { unless ($must_break_open_container) {
if ( $break_count <= 1 ) { if ( $break_count <= 1 ) {
${$rdo_not_break_apart} = 1; ${$rdo_not_break_apart} = 1;
} }
elsif ( $rOpts_line_up_parentheses && !$need_lp_break_open ) elsif ( $rOpts_line_up_parentheses && !$need_lp_break_open )
{ {
${$rdo_not_break_apart} = 1; ${$rdo_not_break_apart} = 1;
} }
} }
set_non_alignment_flags( $comma_count, $rcomma_index );
} }
return; return;
} }
#--------------------------------------------------------------- #---------------------------------------------------------------
# go ahead and format as a table # go ahead and format as a table
#--------------------------------------------------------------- #---------------------------------------------------------------
write_logfile_entry( write_logfile_entry(
"List: auto formatting with $number_of_fields fields/row\n"); "List: auto formatting with $number_of_fields fields/row\n");
skipping to change at line 14904 skipping to change at line 15043
$j += $number_of_fields $j += $number_of_fields
) )
{ {
my $i = $rcomma_index->[$j]; my $i = $rcomma_index->[$j];
set_forced_breakpoint($i); set_forced_breakpoint($i);
} }
return; return;
} }
} }
sub set_non_alignment_flags {
# set flag which indicates that these commas should not be
# aligned
my ( $comma_count, $rcomma_index ) = @_;
foreach ( 0 .. $comma_count - 1 ) {
$matching_token_to_go[ $rcomma_index->[$_] ] = 1;
}
return;
}
sub study_list_complexity { sub study_list_complexity {
# Look for complex tables which should be formatted with one term per line. # Look for complex tables which should be formatted with one term per line.
# Returns the following: # Returns the following:
# #
# \@i_ragged_break_list = list of good breakpoints to avoid lines # \@i_ragged_break_list = list of good breakpoints to avoid lines
# which are hard to read # which are hard to read
# $number_of_fields_best = suggested number of fields based on # $number_of_fields_best = suggested number of fields based on
# complexity; = 0 if any number may be used. # complexity; = 0 if any number may be used.
# #
skipping to change at line 15291 skipping to change at line 15419
FORMATTER_DEBUG_FLAG_UNDOBP && do { FORMATTER_DEBUG_FLAG_UNDOBP && do {
my ( $a, $b, $c ) = caller(); my ( $a, $b, $c ) = caller();
print STDOUT print STDOUT
"Program Bug: undo_forced_breakpoint from $a $c has i=$i but max=$max_index_to_g o"; "Program Bug: undo_forced_breakpoint from $a $c has i=$i but max=$max_index_to_g o";
}; };
} }
} }
return; return;
} }
sub sync_token_K {
my ( $self, $i ) = @_;
# Keep tokens in the rLL array in sync with the _to_go array
my $rLL = $self->{rLL};
my $K = $K_to_go[$i];
if ( defined($K) ) {
$rLL->[$K]->[_TOKEN_] = $tokens_to_go[$i];
}
else {
# shouldn't happen
}
return;
}
{ # begin recombine_breakpoints { # begin recombine_breakpoints
my %is_amp_amp; my %is_amp_amp;
my %is_ternary; my %is_ternary;
my %is_math_op; my %is_math_op;
my %is_plus_minus; my %is_plus_minus;
my %is_mult_div; my %is_mult_div;
BEGIN { BEGIN {
skipping to change at line 15414 skipping to change at line 15557
# semicolons. They were placed by sub respace_tokens but we only now # semicolons. They were placed by sub respace_tokens but we only now
# know if we actually need them. # know if we actually need them.
my $nmax = @{$ri_end} - 1; my $nmax = @{$ri_end} - 1;
foreach my $n ( 0 .. $nmax ) { foreach my $n ( 0 .. $nmax ) {
my $i = $ri_end->[$n]; my $i = $ri_end->[$n];
if ( $types_to_go[$i] eq ';' && $tokens_to_go[$i] eq '' ) { if ( $types_to_go[$i] eq ';' && $tokens_to_go[$i] eq '' ) {
$tokens_to_go[$i] = $want_left_space{';'} == WS_NO ? ';' : ' ;'; $tokens_to_go[$i] = $want_left_space{';'} == WS_NO ? ';' : ' ;';
$self->sync_token_K($i);
my $line_number = 1 + $self->get_old_line_index( $K_to_go[$i] ); my $line_number = 1 + $self->get_old_line_index( $K_to_go[$i] );
note_added_semicolon($line_number); note_added_semicolon($line_number);
} }
} }
return; return;
} }
sub recombine_breakpoints { sub recombine_breakpoints {
skipping to change at line 16455 skipping to change at line 16599
} }
} # end recombine_breakpoints } # end recombine_breakpoints
sub break_all_chain_tokens { sub break_all_chain_tokens {
# scan the current breakpoints looking for breaks at certain "chain # scan the current breakpoints looking for breaks at certain "chain
# operators" (. : && || + etc) which often occur repeatedly in a long # operators" (. : && || + etc) which often occur repeatedly in a long
# statement. If we see a break at any one, break at all similar tokens # statement. If we see a break at any one, break at all similar tokens
# within the same container. # within the same container.
# #
my ( $ri_left, $ri_right ) = @_; my ( $self, $ri_left, $ri_right ) = @_;
my %saw_chain_type; my %saw_chain_type;
my %left_chain_type; my %left_chain_type;
my %right_chain_type; my %right_chain_type;
my %interior_chain_type; my %interior_chain_type;
my $nmax = @{$ri_right} - 1; my $nmax = @{$ri_right} - 1;
# scan the left and right end tokens of all lines # scan the left and right end tokens of all lines
my $count = 0; my $count = 0;
for my $n ( 0 .. $nmax ) { for my $n ( 0 .. $nmax ) {
skipping to change at line 16527 skipping to change at line 16671
# . $contents; # . $contents;
last if ( $nmax == 1 && $type =~ /^[\.\+]$/ ); last if ( $nmax == 1 && $type =~ /^[\.\+]$/ );
# loop over all interior chain tokens # loop over all interior chain tokens
foreach my $itest ( @{ $interior_chain_type{$type} } ) { foreach my $itest ( @{ $interior_chain_type{$type} } ) {
# loop over all left end tokens of same type # loop over all left end tokens of same type
if ( $left_chain_type{$type} ) { if ( $left_chain_type{$type} ) {
next if $nobreak_to_go[ $itest - 1 ]; next if $nobreak_to_go[ $itest - 1 ];
foreach my $i ( @{ $left_chain_type{$type} } ) { foreach my $i ( @{ $left_chain_type{$type} } ) {
next unless in_same_container( $i, $itest ); next unless $self->in_same_container_i( $i, $itest );
push @insert_list, $itest - 1; push @insert_list, $itest - 1;
# Break at matching ? if this : is at a different level. # Break at matching ? if this : is at a different level.
# For example, the ? before $THRf_DEAD in the following # For example, the ? before $THRf_DEAD in the following
# should get a break if its : gets a break. # should get a break if its : gets a break.
# #
# my $flags = # my $flags =
# ( $_ & 1 ) ? ( $_ & 4 ) ? $THRf_DEAD : $THRf_ZOMBIE # ( $_ & 1 ) ? ( $_ & 4 ) ? $THRf_DEAD : $THRf_ZOMBIE
# : ( $_ & 4 ) ? $THRf_R_DETACHED # : ( $_ & 4 ) ? $THRf_R_DETACHED
# : $THRf_R_JOINABLE; # : $THRf_R_JOINABLE;
skipping to change at line 16554 skipping to change at line 16698
} }
} }
last; last;
} }
} }
# loop over all right end tokens of same type # loop over all right end tokens of same type
if ( $right_chain_type{$type} ) { if ( $right_chain_type{$type} ) {
next if $nobreak_to_go[$itest]; next if $nobreak_to_go[$itest];
foreach my $i ( @{ $right_chain_type{$type} } ) { foreach my $i ( @{ $right_chain_type{$type} } ) {
next unless in_same_container( $i, $itest ); next unless $self->in_same_container_i( $i, $itest );
push @insert_list, $itest; push @insert_list, $itest;
# break at matching ? if this : is at a different level # break at matching ? if this : is at a different level
if ( $type eq ':' if ( $type eq ':'
&& $levels_to_go[$i] != $levels_to_go[$itest] ) && $levels_to_go[$i] != $levels_to_go[$itest] )
{ {
my $i_question = $mate_index_to_go[$itest]; my $i_question = $mate_index_to_go[$itest];
if ( $i_question >= 0 ) { if ( $i_question >= 0 ) {
push @insert_list, $i_question; push @insert_list, $i_question;
} }
skipping to change at line 16693 skipping to change at line 16837
# ok, insert any new break point # ok, insert any new break point
if (@insert_list) { if (@insert_list) {
insert_additional_breaks( \@insert_list, $ri_left, $ri_right ); insert_additional_breaks( \@insert_list, $ri_left, $ri_right );
} }
return; return;
} }
sub insert_final_breaks { sub insert_final_breaks {
my ( $ri_left, $ri_right ) = @_; my ( $self, $ri_left, $ri_right ) = @_;
my $nmax = @{$ri_right} - 1; my $nmax = @{$ri_right} - 1;
# scan the left and right end tokens of all lines # scan the left and right end tokens of all lines
my $count = 0; my $count = 0;
my $i_first_colon = -1; my $i_first_colon = -1;
for my $n ( 0 .. $nmax ) { for my $n ( 0 .. $nmax ) {
my $il = $ri_left->[$n]; my $il = $ri_left->[$n];
my $ir = $ri_right->[$n]; my $ir = $ri_right->[$n];
my $typel = $types_to_go[$il]; my $typel = $types_to_go[$il];
my $typer = $types_to_go[$ir]; my $typer = $types_to_go[$ir];
return if ( $typel eq '?' ); return if ( $typel eq '?' );
return if ( $typer eq '?' ); return if ( $typer eq '?' );
if ( $typel eq ':' ) { $i_first_colon = $il; last; } if ( $typel eq ':' ) { $i_first_colon = $il; last; }
elsif ( $typer eq ':' ) { $i_first_colon = $ir; last; } elsif ( $typer eq ':' ) { $i_first_colon = $ir; last; }
} }
# For long ternary chains, # For long ternary chains,
# if the first : we see has its # ? is in the interior # if the first : we see has its ? is in the interior
# of a preceding line, then see if there are any good # of a preceding line, then see if there are any good
# breakpoints before the ?. # breakpoints before the ?.
if ( $i_first_colon > 0 ) { if ( $i_first_colon > 0 ) {
my $i_question = $mate_index_to_go[$i_first_colon]; my $i_question = $mate_index_to_go[$i_first_colon];
if ( $i_question > 0 ) { if ( $i_question > 0 ) {
my @insert_list; my @insert_list;
for ( my $ii = $i_question - 1 ; $ii >= 0 ; $ii -= 1 ) { for ( my $ii = $i_question - 1 ; $ii >= 0 ; $ii -= 1 ) {
my $token = $tokens_to_go[$ii]; my $token = $tokens_to_go[$ii];
my $type = $types_to_go[$ii]; my $type = $types_to_go[$ii];
skipping to change at line 16739 skipping to change at line 16883
# immediately after the return in the following statement: # immediately after the return in the following statement:
# sub x { # sub x {
# return 0 ? 'aaaaaaaaaaaaaaaaaaaaa' : # return 0 ? 'aaaaaaaaaaaaaaaaaaaaa' :
# 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb'; # 'bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb';
# } # }
if ( if (
( (
$type eq ',' $type eq ','
|| $type eq 'k' && ( $nmax > 1 && $token eq 'return' ) || $type eq 'k' && ( $nmax > 1 && $token eq 'return' )
) )
&& in_same_container( $ii, $i_question ) && $self->in_same_container_i( $ii, $i_question )
) )
{ {
push @insert_list, $ii; push @insert_list, $ii;
last; last;
} }
## # For now, a good break is either a comma or a 'return'.
## if ( ( $type eq ',' || $type eq 'k' && $token eq 'return' )
## && in_same_container( $ii, $i_question ) )
## {
## push @insert_list, $ii;
## last;
## }
} }
# insert any new break points # insert any new break points
if (@insert_list) { if (@insert_list) {
insert_additional_breaks( \@insert_list, $ri_left, $ri_right ); insert_additional_breaks( \@insert_list, $ri_left, $ri_right );
} }
} }
} }
return; return;
} }
sub in_same_container { sub in_same_container_i {
# check to see if tokens at i1 and i2 are in the # check to see if tokens at i1 and i2 are in the
# same container, and not separated by a comma, ? or : # same container, and not separated by a comma, ? or :
# FIXME: this can be written more efficiently now # This is an interface between the _to_go arrays to the rLL array
my ( $i1, $i2 ) = @_; my ( $self, $i1, $i2 ) = @_;
my $type = $types_to_go[$i1]; return $self->in_same_container_K( $K_to_go[$i1], $K_to_go[$i2] );
my $depth = $nesting_depth_to_go[$i1]; }
return unless ( $nesting_depth_to_go[$i2] == $depth );
if ( $i2 < $i1 ) { ( $i1, $i2 ) = ( $i2, $i1 ) }
###########################################################
# This is potentially a very slow routine and not critical.
# For safety just give up for large differences.
# See test file 'infinite_loop.txt'
# TODO: replace this loop with a data structure
###########################################################
return if ( $i2 - $i1 > 200 );
foreach my $i ( $i1 + 1 .. $i2 - 1 ) {
next if ( $nesting_depth_to_go[$i] > $depth );
return if ( $nesting_depth_to_go[$i] < $depth );
my $tok = $tokens_to_go[$i]; { # sub in_same_container_K
$tok = ',' if $tok eq '=>'; # treat => same as , my $ris_break_token;
my $ris_comma_token;
BEGIN {
# all cases break on seeing commas at same level
my @q = qw( => );
push @q, ',';
@{$ris_comma_token}{@q} = (1) x scalar(@q);
# Non-ternary text also breaks on seeing any of qw(? : || or )
# Example: we would not want to break at any of these .'s # Example: we would not want to break at any of these .'s
# : "<A HREF=\"#item_" . htmlify( 0, $s2 ) . "\">$str</A>" # : "<A HREF=\"#item_" . htmlify( 0, $s2 ) . "\">$str</A>"
if ( $type ne ':' ) { push @q, qw( or || ? : );
return if ( $tok =~ /^[\,\:\?]$/ ) || $tok eq '||' || $tok eq 'or'; @{$ris_break_token}{@q} = (1) x scalar(@q);
}
sub in_same_container_K {
# Check to see if tokens at K1 and K2 are in the same container,
# and not separated by certain characters: => , ? : || or
# This version uses the newer $rLL data structure
my ( $self, $K1, $K2 ) = @_;
if ( $K2 < $K1 ) { ( $K1, $K2 ) = ( $K2, $K1 ) }
my $rLL = $self->{rLL};
my $depth_1 = $rLL->[$K1]->[_SLEVEL_];
return if ( $depth_1 < 0 );
return unless ( $rLL->[$K2]->[_SLEVEL_] == $depth_1 );
# Select character set to scan for
my $type_1 = $rLL->[$K1]->[_TYPE_];
my $rbreak = ( $type_1 ne ':' ) ? $ris_break_token : $ris_comma_token;
# Fast preliminary loop to verify that tokens are in the same container
my $KK = $K1;
while (1) {
$KK = $rLL->[$KK]->[_KNEXT_SEQ_ITEM_];
last if !defined($KK);
last if ( $KK >= $K2 );
my $depth_K = $rLL->[$KK]->[_SLEVEL_];
return if ( $depth_K < $depth_1 );
next if ( $depth_K > $depth_1 );
if ( $type_1 ne ':' ) {
my $tok_K = $rLL->[$KK]->[_TOKEN_];
return if ( $tok_K eq '?' || $tok_K eq ':' );
}
} }
else {
return if ( $tok =~ /^[\,]$/ ); # Slow loop checking for certain characters
###########################################################
# This is potentially a slow routine and not critical.
# For safety just give up for large differences.
# See test file 'infinite_loop.txt'
###########################################################
return if ( $K2 - $K1 > 200 );
foreach my $K ( $K1 + 1 .. $K2 - 1 ) {
my $depth_K = $rLL->[$K]->[_SLEVEL_];
next if ( $depth_K > $depth_1 );
return if ( $depth_K < $depth_1 ); # redundant, checked above
my $tok = $rLL->[$K]->[_TOKEN_];
return if ( $rbreak->{$tok} );
} }
return 1;
} }
return 1;
} }
sub set_continuation_breaks { sub set_continuation_breaks {
# Define an array of indexes for inserting newline characters to # Define an array of indexes for inserting newline characters to
# keep the line lengths below the maximum desired length. There is # keep the line lengths below the maximum desired length. There is
# an implied break after the last token, so it need not be included. # an implied break after the last token, so it need not be included.
# Method: # Method:
# This routine is part of series of routines which adjust line # This routine is part of series of routines which adjust line
skipping to change at line 16832 skipping to change at line 17010
# @i_first # @i_first
# @i_last # @i_last
# which contain the indexes $i of the first and last tokens on each # which contain the indexes $i of the first and last tokens on each
# line. # line.
# In addition, the array: # In addition, the array:
# $forced_breakpoint_to_go[$i] # $forced_breakpoint_to_go[$i]
# may be updated to be =1 for any index $i after which there must be # may be updated to be =1 for any index $i after which there must be
# a break. This signals later routines not to undo the breakpoint. # a break. This signals later routines not to undo the breakpoint.
my $saw_good_break = shift; my ( $self, $saw_good_break ) = @_;
my @i_first = (); # the first index to output my @i_first = (); # the first index to output
my @i_last = (); # the last index to output my @i_last = (); # the last index to output
my @i_colon_breaks = (); # needed to decide if we have to break at ?'s my @i_colon_breaks = (); # needed to decide if we have to break at ?'s
if ( $types_to_go[0] eq ':' ) { push @i_colon_breaks, 0 } if ( $types_to_go[0] eq ':' ) { push @i_colon_breaks, 0 }
set_bond_strengths(); set_bond_strengths();
my $imin = 0; my $imin = 0;
my $imax = $max_index_to_go; my $imax = $max_index_to_go;
if ( $types_to_go[$imin] eq 'b' ) { $imin++ } if ( $types_to_go[$imin] eq 'b' ) { $imin++ }
if ( $types_to_go[$imax] eq 'b' ) { $imax-- } if ( $types_to_go[$imax] eq 'b' ) { $imax-- }
my $i_begin = $imin; # index for starting next iteration my $i_begin = $imin; # index for starting next iteration
my $leading_spaces = leading_spaces_to_go($imin); my $leading_spaces = leading_spaces_to_go($imin);
my $line_count = 0; my $line_count = 0;
my $last_break_strength = NO_BREAK; my $last_break_strength = NO_BREAK;
my $i_last_break = -1; my $i_last_break = -1;
my $max_bias = 0.001; my $max_bias = 0.001;
my $tiny_bias = 0.0001; my $tiny_bias = 0.0001;
my $leading_alignment_token = ""; my $leading_alignment_token = "";
my $leading_alignment_type = ""; my $leading_alignment_type = "";
skipping to change at line 17261 skipping to change at line 17439
# line from its closing ':', then break at the '?' instead. # line from its closing ':', then break at the '?' instead.
#------------------------------------------------------- #-------------------------------------------------------
foreach my $i ( $i_begin + 1 .. $i_lowest - 1 ) { foreach my $i ( $i_begin + 1 .. $i_lowest - 1 ) {
next unless ( $tokens_to_go[$i] eq '?' ); next unless ( $tokens_to_go[$i] eq '?' );
# do not break if probable sequence of ?/: statements # do not break if probable sequence of ?/: statements
next if ($is_colon_chain); next if ($is_colon_chain);
# do not break if statement is broken by side comment # do not break if statement is broken by side comment
next next
if ( if ( $tokens_to_go[$max_index_to_go] eq '#'
$tokens_to_go[$max_index_to_go] eq '#' && $self->terminal_type_i( 0, $max_index_to_go ) !~
&& terminal_type( \@types_to_go, \@block_type_to_go, 0, /^[\;\}]$/ );
$max_index_to_go ) !~ /^[\;\}]$/
);
# no break needed if matching : is also on the line # no break needed if matching : is also on the line
next next
if ( $mate_index_to_go[$i] >= 0 if ( $mate_index_to_go[$i] >= 0
&& $mate_index_to_go[$i] <= $i_next_nonblank ); && $mate_index_to_go[$i] <= $i_next_nonblank );
$i_lowest = $i; $i_lowest = $i;
if ( $want_break_before{'?'} ) { $i_lowest-- } if ( $want_break_before{'?'} ) { $i_lowest-- }
last; last;
} }
 End of changes. 145 change blocks. 
436 lines changed or deleted 614 lines changed or added

Home  |  About  |  Features  |  All  |  Newest  |  Dox  |  Diffs  |  RSS Feeds  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTP(S)