package Perl::Tidy::VerticalAligner;
use strict;
use warnings;
-our $VERSION = '20210717';
-
+use Carp;
+use English qw( -no_match_vars );
+our $VERSION = '20220613';
use Perl::Tidy::VerticalAligner::Alignment;
use Perl::Tidy::VerticalAligner::Line;
+use constant DEVEL_MODE => 0;
+use constant EMPTY_STRING => q{};
+use constant SPACE => q{ };
+
# The Perl::Tidy::VerticalAligner package collects output lines and
# attempts to line up certain common tokens, such as => and #, which are
# identified by the calling routine.
#
# The sub valign_input collects lines into groups. When a group reaches
# the maximum possible size it is processed for alignment and output.
-# The maximum group size is reached whenerver there is a change in indentation
+# The maximum group size is reached whenever there is a change in indentation
# level, a blank line, a block comment, or an external flush call. The calling
# routine may also force a break in alignment at any time.
#
# required to avoid call to AUTOLOAD in some versions of perl
}
+sub Die {
+ my ($msg) = @_;
+ Perl::Tidy::Die($msg);
+ croak "unexpected return from Perl::Tidy::Die";
+}
+
+sub Fault {
+ my ($msg) = @_;
+
+ # This routine is called for errors that really should not occur
+ # except if there has been a bug introduced by a recent program change.
+ # Please add comments at calls to Fault to explain why the call
+ # should not occur, and where to look to fix it.
+ my ( $package0, $filename0, $line0, $subroutine0 ) = caller(0);
+ my ( $package1, $filename1, $line1, $subroutine1 ) = caller(1);
+ my ( $package2, $filename2, $line2, $subroutine2 ) = caller(2);
+ my $input_stream_name = get_input_stream_name();
+
+ Die(<<EOM);
+==============================================================================
+While operating on input stream with name: '$input_stream_name'
+A fault was detected at line $line0 of sub '$subroutine1'
+in file '$filename1'
+which was called from line $line1 of sub '$subroutine2'
+Message: '$msg'
+This is probably an error introduced by a recent programming change.
+Perl::Tidy::VerticalAligner.pm reports VERSION='$VERSION'.
+==============================================================================
+EOM
+
+ # We shouldn't get here, but this return is to keep Perl-Critic from
+ # complaining.
+ return;
+}
+
BEGIN {
# Define the fixed indexes for variables in $self, which is an array
# reference. Note the convention of leading and trailing underscores to
# keep them unique.
+ # Do not combine with other BEGIN blocks (c101).
my $i = 0;
use constant {
_file_writer_object_ => $i++,
_diagnostics_object_ => $i++,
_length_function_ => $i++,
- _rOpts_ => $i++,
- _rOpts_indent_columns_ => $i++,
- _rOpts_tabs_ => $i++,
- _rOpts_entab_leading_whitespace_ => $i++,
- _rOpts_fixed_position_side_comment_ => $i++,
- _rOpts_minimum_space_to_comment_ => $i++,
- _rOpts_maximum_line_length_ => $i++,
- _rOpts_variable_maximum_line_length_ => $i++,
- _rOpts_valign_ => $i++,
+ _rOpts_ => $i++,
+ _rOpts_indent_columns_ => $i++,
+ _rOpts_tabs_ => $i++,
+ _rOpts_entab_leading_whitespace_ => $i++,
+ _rOpts_fixed_position_side_comment_ => $i++,
+ _rOpts_minimum_space_to_comment_ => $i++,
+ _rOpts_valign_code_ => $i++,
+ _rOpts_valign_block_comments_ => $i++,
+ _rOpts_valign_side_comments_ => $i++,
_last_level_written_ => $i++,
_last_side_comment_column_ => $i++,
_rgroup_lines_ => $i++,
_group_level_ => $i++,
_group_type_ => $i++,
+ _group_maximum_line_length_ => $i++,
_zero_count_ => $i++,
_last_leading_space_count_ => $i++,
_comment_leading_space_count_ => $i++,
};
DEBUG_TABS && $debug_warning->('TABS');
+}
+
+# GLOBAL variables
+my (
+
+ %valign_control_hash,
+ $valign_control_default,
+
+);
+
+sub check_options {
+
+ # This routine is called to check the user-supplied run parameters
+ # and to configure the control hashes to them.
+ my ($rOpts) = @_;
+
+ # All alignments are done by default
+ %valign_control_hash = ();
+ $valign_control_default = 1;
+ # If -vil=s is entered without -vxl, assume -vxl='*'
+ if ( !$rOpts->{'valign-exclusion-list'}
+ && $rOpts->{'valign-inclusion-list'} )
+ {
+ $rOpts->{'valign-exclusion-list'} = '*';
+ }
+
+ # See if the user wants to exclude any alignment types ...
+ if ( $rOpts->{'valign-exclusion-list'} ) {
+
+ # The inclusion list is only relevant if there is an exclusion list
+ if ( $rOpts->{'valign-inclusion-list'} ) {
+ my @vil = split /\s+/, $rOpts->{'valign-inclusion-list'};
+ @valign_control_hash{@vil} = (1) x scalar(@vil);
+ }
+
+ # Note that the -vxl list is done after -vil, so -vxl has priority
+ # in the event of duplicate entries.
+ my @vxl = split /\s+/, $rOpts->{'valign-exclusion-list'};
+ @valign_control_hash{@vxl} = (0) x scalar(@vxl);
+
+ # Optimization: revert to defaults if no exclusions.
+ # This could happen with -vxl=' ' and any -vil list
+ if ( !@vxl ) {
+ %valign_control_hash = ();
+ }
+
+ # '$valign_control_default' applies to types not in the hash:
+ # - If a '*' was entered then set it to be that default type
+ # - Otherwise, leave it set it to 1
+ if ( defined( $valign_control_hash{'*'} ) ) {
+ $valign_control_default = $valign_control_hash{'*'};
+ }
+
+ # Side comments are controlled separately and must be removed
+ # if given in a list.
+ if (%valign_control_hash) {
+ $valign_control_hash{'#'} = 1;
+ }
+ }
+
+ return;
}
sub new {
initialize_valign_buffer();
initialize_leading_string_cache();
initialize_decode();
+ set_logger_object( $args{logger_object} );
# Initialize all variables in $self.
# To add an item to $self, first define a new constant index in the BEGIN
$rOpts->{'fixed-position-side-comment'};
$self->[_rOpts_minimum_space_to_comment_] =
$rOpts->{'minimum-space-to-comment'};
- $self->[_rOpts_maximum_line_length_] = $rOpts->{'maximum-line-length'};
- $self->[_rOpts_variable_maximum_line_length_] =
- $rOpts->{'variable-maximum-line-length'};
- $self->[_rOpts_valign_] = $rOpts->{'valign'};
+ $self->[_rOpts_valign_code_] = $rOpts->{'valign-code'};
+ $self->[_rOpts_valign_block_comments_] = $rOpts->{'valign-block-comments'};
+ $self->[_rOpts_valign_side_comments_] = $rOpts->{'valign-side-comments'};
# Batch of lines being collected
$self->[_rgroup_lines_] = [];
$self->[_group_level_] = 0;
- $self->[_group_type_] = "";
+ $self->[_group_type_] = EMPTY_STRING;
+ $self->[_group_maximum_line_length_] = undef;
$self->[_zero_count_] = 0;
$self->[_comment_leading_space_count_] = 0;
$self->[_last_leading_space_count_] = 0;
# flush() is the external call to completely empty the pipeline.
my ($self) = @_;
- # push things out the pipline...
+ # push things out the pipeline...
# push out any current group lines
$self->_flush_group_lines();
my ($self) = @_;
$self->[_rgroup_lines_] = [];
- $self->[_group_type_] = "";
+ $self->[_group_type_] = EMPTY_STRING;
$self->[_zero_count_] = 0;
$self->[_comment_leading_space_count_] = 0;
$self->[_last_leading_space_count_] = 0;
+ $self->[_group_maximum_line_length_] = undef;
# Note that the value for _group_level_ is
# handled separately in sub valign_input
return;
}
-# interface to Perl::Tidy::Logger routines
-sub warning {
- my ( $self, $msg ) = @_;
- my $logger_object = $self->[_logger_object_];
- if ($logger_object) {
- $logger_object->warning($msg);
+{ ## begin closure for logger routines
+ my $logger_object;
+
+ # Called once per file to initialize the logger object
+ sub set_logger_object {
+ $logger_object = shift;
+ return;
}
- return;
-}
-sub write_logfile_entry {
- my ( $self, $msg ) = @_;
- my $logger_object = $self->[_logger_object_];
- if ($logger_object) {
- $logger_object->write_logfile_entry($msg);
+ sub get_logger_object {
+ return $logger_object;
}
- return;
-}
-sub report_definite_bug {
- my ( $self, $msg ) = @_;
- my $logger_object = $self->[_logger_object_];
- if ($logger_object) {
- $logger_object->report_definite_bug();
+ sub get_input_stream_name {
+ my $input_stream_name = EMPTY_STRING;
+ if ($logger_object) {
+ $input_stream_name = $logger_object->get_input_stream_name();
+ }
+ return $input_stream_name;
+ }
+
+ sub warning {
+ my ($msg) = @_;
+ if ($logger_object) {
+ $logger_object->warning($msg);
+ }
+ return;
+ }
+
+ sub write_logfile_entry {
+ my ($msg) = @_;
+ if ($logger_object) {
+ $logger_object->write_logfile_entry($msg);
+ }
+ return;
}
- return;
}
sub get_cached_line_count {
return $self->group_line_count() + ( get_cached_line_type() ? 1 : 0 );
}
-sub get_spaces {
-
- # return the number of leading spaces associated with an indentation
- # variable $indentation is either a constant number of spaces or an
- # object with a get_spaces method.
- my $indentation = shift;
- return ref($indentation) ? $indentation->get_spaces() : $indentation;
-}
-
sub get_recoverable_spaces {
# return the number of spaces (+ means shift right, - means shift left)
return ref($indentation) ? $indentation->get_recoverable_spaces() : 0;
}
-sub maximum_line_length_for_level {
-
- # return maximum line length for line starting with a given level
- my ( $self, $level ) = @_;
- my $maximum_line_length = $self->[_rOpts_maximum_line_length_];
- if ( $self->[_rOpts_variable_maximum_line_length_] ) {
- if ( $level < 0 ) { $level = 0 }
- $maximum_line_length += $level * $self->[_rOpts_indent_columns_];
- }
- return $maximum_line_length;
-}
-
######################################################
# CODE SECTION 3: Code to accept input and form groups
######################################################
use constant DEBUG_VALIGN => 0;
use constant SC_LONG_LINE_DIFF => 12;
+my %is_closing_token;
+
+BEGIN {
+ my @q = qw< } ) ] >;
+ @is_closing_token{@q} = (1) x scalar(@q);
+}
+
+#--------------------------------------------
+# VTFLAGS: Vertical tightness types and flags
+#--------------------------------------------
+# Vertical tightness is controlled by a 'type' and associated 'flags' for each
+# line. These values are set by sub Formatter::set_vertical_tightness_flags.
+# These are defined as follows:
+
+# Vertical Tightness Line Type Codes:
+# Type 0, no vertical tightness condition
+# Type 1, last token of this line is a non-block opening token
+# Type 2, first token of next line is a non-block closing
+# Type 3, isolated opening block brace
+# type 4, isolated closing block brace
+
+# Opening token flag values are the vertical tightness flags
+# 0 do not join with next line
+# 1 just one join per line
+# 2 any number of joins
+
+# Closing token flag values indicate spacing:
+# 0 = no space added before closing token
+# 1 = single space added before closing token
+
sub valign_input {
# Place one line in the current vertical group.
#
- # The input parameters are:
- # $level = indentation level of this line
- # $rfields = reference to array of fields
- # $rpatterns = reference to array of patterns, one per field
- # $rtokens = reference to array of tokens starting fields 1,2,..
+ # The key input parameters describing each line are:
+ # $level = indentation level of this line
+ # $rfields = ref to array of fields
+ # $rpatterns = ref to array of patterns, one per field
+ # $rtokens = ref to array of tokens starting fields 1,2,..
+ # $rfield_lengths = ref to array of field display widths
#
# Here is an example of what this package does. In this example,
# we are trying to line up both the '=>' and the '#'.
my $level = $rline_hash->{level};
my $level_end = $rline_hash->{level_end};
- my $level_adj = $rline_hash->{level_adj};
my $indentation = $rline_hash->{indentation};
my $list_seqno = $rline_hash->{list_seqno};
my $outdent_long_lines = $rline_hash->{outdent_long_lines};
my $is_terminal_ternary = $rline_hash->{is_terminal_ternary};
my $rvertical_tightness_flags = $rline_hash->{rvertical_tightness_flags};
- my $level_jump = $rline_hash->{level_jump};
- my $rfields = $rline_hash->{rfields};
- my $rtokens = $rline_hash->{rtokens};
- my $rpatterns = $rline_hash->{rpatterns};
- my $rfield_lengths = $rline_hash->{rfield_lengths};
- my $terminal_block_type = $rline_hash->{terminal_block_type};
- my $batch_count = $rline_hash->{batch_count};
my $break_alignment_before = $rline_hash->{break_alignment_before};
my $break_alignment_after = $rline_hash->{break_alignment_after};
my $Kend = $rline_hash->{Kend};
my $ci_level = $rline_hash->{ci_level};
+ my $maximum_line_length = $rline_hash->{maximum_line_length};
+ my $forget_side_comment = $rline_hash->{forget_side_comment};
+ my $rline_alignment = $rline_hash->{rline_alignment};
+
+ my ( $rtokens, $rfields, $rpatterns, $rfield_lengths ) =
+ @{$rline_alignment};
# The index '$Kend' is a value which passed along with the line text to sub
# 'write_code_line' for a convergence check.
# number of tokens between fields is $jmax-1
my $jmax = @{$rfields} - 1;
- my $leading_space_count = get_spaces($indentation);
+ my $leading_space_count =
+ ref($indentation) ? $indentation->get_spaces() : $indentation;
# set outdented flag to be sure we either align within statements or
# across statement boundaries, but not both.
# Reset side comment location if we are entering a new block from level 0.
# This is intended to keep them from drifting too far to the right.
- if ( $terminal_block_type && $level_adj == 0 && $level_end > $level ) {
+ if ($forget_side_comment) {
$self->forget_side_comment();
}
- my $group_level = $self->[_group_level_];
+ my $is_balanced_line = $level_end == $level;
+
+ my $group_level = $self->[_group_level_];
+ my $group_maximum_line_length = $self->[_group_maximum_line_length_];
DEBUG_VALIGN && do {
my $nlines = $self->group_line_count();
print STDOUT
-"Entering valign_input: lines=$nlines new #fields= $jmax, leading_count=$leading_space_count, level_jump=$level_jump, level=$level, group_level=$group_level, level_jump=$level_jump\n";
+"Entering valign_input: lines=$nlines new #fields= $jmax, leading_count=$leading_space_count, level=$level, group_level=$group_level, level_end=$level_end\n";
};
# Validate cached line if necessary: If we can produce a container
# cached flags as valid.
my $cached_line_type = get_cached_line_type();
if ($cached_line_type) {
- my $cached_line_flag = get_cached_line_flag();
+ my $cached_line_opening_flag = get_cached_line_opening_flag();
if ($rvertical_tightness_flags) {
my $cached_seqno = get_cached_seqno();
if ( $cached_seqno
- && $self->group_line_count() <= 1
- && $rvertical_tightness_flags->[2]
- && $rvertical_tightness_flags->[2] == $cached_seqno )
+ && $rvertical_tightness_flags->{_vt_seqno}
+ && $rvertical_tightness_flags->{_vt_seqno} == $cached_seqno )
{
- $rvertical_tightness_flags->[3] ||= 1;
- set_cached_line_valid(1);
+
+ # Fix for b1187 and b1188: Normally this step is only done
+ # if the number of existing lines is 0 or 1. But to prevent
+ # blinking, this range can be controlled by the caller.
+ # If zero values are given we fall back on the range 0 to 1.
+ my $line_count = $self->group_line_count();
+ my $min_lines = $rvertical_tightness_flags->{_vt_min_lines};
+ my $max_lines = $rvertical_tightness_flags->{_vt_max_lines};
+ $min_lines = 0 unless ($min_lines);
+ $max_lines = 1 unless ($max_lines);
+ if ( ( $line_count >= $min_lines )
+ && ( $line_count <= $max_lines ) )
+ {
+ $rvertical_tightness_flags->{_vt_valid_flag} ||= 1;
+ set_cached_line_valid(1);
+ }
}
}
- # do not join an opening block brace with an unbalanced line
- # unless requested with a flag value of 2
+ # do not join an opening block brace (type 3, see VTFLAGS)
+ # with an unbalanced line unless requested with a flag value of 2
if ( $cached_line_type == 3
&& !$self->group_line_count()
- && $cached_line_flag < 2
- && $level_jump != 0 )
+ && $cached_line_opening_flag < 2
+ && !$is_balanced_line )
{
set_cached_line_valid(0);
}
if ( $level < 0 ) { $level = 0 }
# do not align code across indentation level changes
- # or if vertical alignment is turned off for debugging
- if ( $level != $group_level || $is_outdented || !$self->[_rOpts_valign_] ) {
+ # or changes in the maximum line length
+ # or if vertical alignment is turned off
+ if (
+ $level != $group_level
+ || ( $group_maximum_line_length
+ && $maximum_line_length != $group_maximum_line_length )
+ || $is_outdented
+ || ( $is_block_comment && !$self->[_rOpts_valign_block_comments_] )
+ || ( !$is_block_comment
+ && !$self->[_rOpts_valign_side_comments_]
+ && !$self->[_rOpts_valign_code_] )
+ )
+ {
$self->_flush_group_lines( $level - $group_level );
- $group_level = $level;
- $self->[_group_level_] = $group_level;
-
- # wait until after the above flush to get the leading space
- # count because it may have been changed if the -icp flag is in
- # effect
- $leading_space_count = get_spaces($indentation);
+ $group_level = $level;
+ $self->[_group_level_] = $group_level;
+ $self->[_group_maximum_line_length_] = $maximum_line_length;
+ # Update leading spaces after the above flush because the leading space
+ # count may have been changed if the -icp flag is in effect
+ $leading_space_count =
+ ref($indentation) ? $indentation->get_spaces() : $indentation;
}
# --------------------------------------------------------------------
# Collect outdentable block COMMENTS
# --------------------------------------------------------------------
- my $is_blank_line = "";
+ my $is_blank_line = EMPTY_STRING;
if ( $self->[_group_type_] eq 'COMMENT' ) {
if (
(
# alignment of the '{'.
if ( $rfields->[0] eq 'else '
&& @{$rgroup_lines}
- && $level_jump == 0 )
+ && $is_balanced_line )
{
$j_terminal_match =
{
$self->[_group_type_] = 'COMMENT';
$self->[_comment_leading_space_count_] = $leading_space_count;
+ $self->[_group_maximum_line_length_] = $maximum_line_length;
$self->push_group_line(
[ $rfields->[0], $rfield_lengths->[0], $Kend ] );
return;
level => $level,
level_end => $level_end,
Kend => $Kend,
+ maximum_line_length => $maximum_line_length,
}
);
-
return;
}
}
$self->[_zero_count_] = 0;
}
- my $maximum_line_length_for_level =
- $self->maximum_line_length_for_level($level);
-
# --------------------------------------------------------------------
# It simplifies things to create a zero length side comment
# if none exists.
# --------------------------------------------------------------------
- $self->make_side_comment( $rtokens, $rfields, $rpatterns, $rfield_lengths );
- $jmax = @{$rfields} - 1;
+ if ( ( $jmax == 0 ) || ( $rtokens->[ $jmax - 1 ] ne '#' ) ) {
+ $jmax += 1;
+ $rtokens->[ $jmax - 1 ] = '#';
+ $rfields->[$jmax] = EMPTY_STRING;
+ $rfield_lengths->[$jmax] = 0;
+ $rpatterns->[$jmax] = '#';
+ }
# --------------------------------------------------------------------
# create an object to hold this line
leading_space_count => $leading_space_count,
outdent_long_lines => $outdent_long_lines,
list_seqno => $list_seqno,
- list_type => "",
+ list_type => EMPTY_STRING,
is_hanging_side_comment => $is_hanging_side_comment,
- maximum_line_length => $maximum_line_length_for_level,
rvertical_tightness_flags => $rvertical_tightness_flags,
is_terminal_ternary => $is_terminal_ternary,
j_terminal_match => $j_terminal_match,
level => $level,
level_end => $level_end,
imax_pair => -1,
+ maximum_line_length => $maximum_line_length,
}
);
# --------------------------------------------------------------------
$self->push_group_line($new_line);
+ $self->[_group_maximum_line_length_] = $maximum_line_length;
# output this group if it ends in a terminal else or ternary line
if ( defined($j_terminal_match) ) {
}
# Force break after jump to lower level
- if ( $level_jump < 0 ) {
- $self->_flush_group_lines($level_jump);
+ elsif ($level_end < $level
+ || $is_closing_token{ substr( $rfields->[0], 0, 1 ) } )
+ {
+ $self->_flush_group_lines(-1);
}
# --------------------------------------------------------------------
$rtokens->[ $jmax - 1 ] = $rtokens->[0];
$rpatterns->[ $jmax - 1 ] = $rpatterns->[0];
foreach my $j ( 1 .. $jmax - 1 ) {
- $rfields->[$j] = '';
+ $rfields->[$j] = EMPTY_STRING;
$rfield_lengths->[$j] = 0;
- $rtokens->[ $j - 1 ] = "";
- $rpatterns->[ $j - 1 ] = "";
+ $rtokens->[ $j - 1 ] = EMPTY_STRING;
+ $rpatterns->[ $j - 1 ] = EMPTY_STRING;
}
return 1;
}
-sub make_side_comment {
-
- # create an empty side comment if none exists
-
- my ( $self, $rtokens, $rfields, $rpatterns, $rfield_lengths ) = @_;
-
- my $jmax = @{$rfields} - 1;
-
- # if line does not have a side comment...
- if ( ( $jmax == 0 ) || ( $rtokens->[ $jmax - 1 ] ne '#' ) ) {
- $jmax += 1;
- $rtokens->[ $jmax - 1 ] = '#';
- $rfields->[$jmax] = '';
- $rfield_lengths->[$jmax] = 0;
- $rpatterns->[$jmax] = '#';
- }
- return;
-}
-
{ ## closure for sub decide_if_list
my %is_comma_token;
( $raw_tok, $lev, $tag, $tok_count ) =
decode_alignment_token( $rtokens->[$_] );
if ( !$is_comma_token{$raw_tok} ) {
- $list_type = "";
+ $list_type = EMPTY_STRING;
last;
}
}
return unless ($old_line);
use constant EXPLAIN_TERNARY => 0;
+ if (%valign_control_hash) {
+ my $align_ok = $valign_control_hash{'?'};
+ $align_ok = $valign_control_default unless defined($align_ok);
+ return unless ($align_ok);
+ }
+
my $jmax = @{$rfields} - 1;
my $rfields_old = $old_line->get_rfields();
# look for the question mark after the :
my ($jquestion);
my $depth_question;
- my $pad = "";
+ my $pad = EMPTY_STRING;
my $pad_length = 0;
foreach my $j ( 0 .. $maximum_field_index - 1 ) {
my $tok = $rtokens_old->[$j];
$jquestion = $j;
if ( $rfields_old->[ $j + 1 ] =~ /^(\?\s*)/ ) {
$pad_length = length($1);
- $pad = " " x $pad_length;
+ $pad = SPACE x $pad_length;
}
else {
return; # shouldn't happen
my @field_lengths = @{$rfield_lengths};
EXPLAIN_TERNARY && do {
- local $" = '><';
+ local $LIST_SEPARATOR = '><';
print STDOUT "CURRENT FIELDS=<@{$rfields_old}>\n";
print STDOUT "CURRENT TOKENS=<@{$rtokens_old}>\n";
print STDOUT "CURRENT PATTERNS=<@{$rpatterns_old}>\n";
unshift( @patterns, @{$rpatterns_old}[ 0 .. $jquestion ] );
# insert appropriate number of empty fields
- splice( @fields, 1, 0, ('') x $jadd ) if $jadd;
- splice( @field_lengths, 1, 0, (0) x $jadd ) if $jadd;
+ splice( @fields, 1, 0, (EMPTY_STRING) x $jadd ) if $jadd;
+ splice( @field_lengths, 1, 0, (0) x $jadd ) if $jadd;
}
# handle sub-case of first field just equal to leading colon.
# leading token and inserting appropriate number of empty fields
splice( @tokens, 0, 1, @{$rtokens_old}[ 0 .. $jquestion ] );
splice( @patterns, 1, 0, @{$rpatterns_old}[ 1 .. $jquestion ] );
- splice( @fields, 1, 0, ('') x $jadd ) if $jadd;
- splice( @field_lengths, 1, 0, (0) x $jadd ) if $jadd;
+ splice( @fields, 1, 0, (EMPTY_STRING) x $jadd ) if $jadd;
+ splice( @field_lengths, 1, 0, (0) x $jadd ) if $jadd;
}
}
$jadd = $jquestion + 1;
$fields[0] = $pad . $fields[0];
$field_lengths[0] = $pad_length + $field_lengths[0];
- splice( @fields, 0, 0, ('') x $jadd ) if $jadd;
- splice( @field_lengths, 0, 0, (0) x $jadd ) if $jadd;
+ splice( @fields, 0, 0, (EMPTY_STRING) x $jadd ) if $jadd;
+ splice( @field_lengths, 0, 0, (0) x $jadd ) if $jadd;
}
EXPLAIN_TERNARY && do {
- local $" = '><';
+ local $LIST_SEPARATOR = '><';
print STDOUT "MODIFIED TOKENS=<@tokens>\n";
print STDOUT "MODIFIED PATTERNS=<@patterns>\n";
print STDOUT "MODIFIED FIELDS=<@fields>\n";
my $jmax = @{$rfields} - 1;
return unless ( $jmax > 0 );
+ if (%valign_control_hash) {
+ my $align_ok = $valign_control_hash{'{'};
+ $align_ok = $valign_control_default unless defined($align_ok);
+ return unless ($align_ok);
+ }
+
# check for balanced else block following if/elsif/unless
my $rfields_old = $old_line->get_rfields();
my $jadd = $jbrace - $jparen;
splice( @{$rtokens}, 0, 0, @{$rtokens_old}[ $jparen .. $jbrace - 1 ] );
splice( @{$rpatterns}, 1, 0, @{$rpatterns_old}[ $jparen + 1 .. $jbrace ] );
- splice( @{$rfields}, 1, 0, ('') x $jadd );
+ splice( @{$rfields}, 1, 0, (EMPTY_STRING) x $jadd );
splice( @{$rfield_lengths}, 1, 0, (0) x $jadd );
# force a flush after this line if it does not follow a case
my $imax_align = -1;
# variable $GoToMsg explains reason for no match, for debugging
- my $GoToMsg = "";
+ my $GoToMsg = EMPTY_STRING;
use constant EXPLAIN_CHECK_MATCH => 0;
# This is a flag for testing alignment by sub sweep_left_to_right only.
my $rfield_lengths = $new_line->get_rfield_lengths();
my $padding_available = $old_line->get_available_space_on_right();
my $jmax_old = $old_line->get_jmax();
+ my $rtokens_old = $old_line->get_rtokens();
# Safety check ... only lines with equal array sizes should arrive here
# from sub check_match. So if this error occurs, look at recent changes in
# identical numbers of alignment tokens.
if ( $jmax_old ne $jmax ) {
- $self->warning(<<EOM);
+ warning(<<EOM);
Program bug detected in Perl::Tidy::VerticalAligner sub check_fit
unexpected difference in array lengths: $jmax != $jmax_old
EOM
}
# Keep going if this field does not need any space.
- next if $pad < 0;
+ next if ( $pad < 0 );
- # See if it needs too much space.
+ # Revert to the starting state if does not fit
if ( $pad > $padding_available ) {
################################################
sub dump_array {
# debug routine to dump array contents
- local $" = ')(';
+ local $LIST_SEPARATOR = ')(';
print STDOUT "(@_)\n";
return;
}
my ($self) = @_;
my $rgroup_lines = $self->[_rgroup_lines_];
return unless ( @{$rgroup_lines} );
- my $group_level = $self->[_group_level_];
- my $leading_space_count = $self->[_comment_leading_space_count_];
+ my $group_level = $self->[_group_level_];
+ my $group_maximum_line_length = $self->[_group_maximum_line_length_];
+ my $leading_space_count = $self->[_comment_leading_space_count_];
my $leading_string =
$self->get_leading_string( $leading_space_count, $group_level );
foreach my $item ( @{$rgroup_lines} ) {
my ( $str, $str_len ) = @{$item};
my $excess =
- $str_len +
- $leading_space_count -
- $self->maximum_line_length_for_level($group_level);
+ $str_len + $leading_space_count - $group_maximum_line_length;
if ( $excess > $max_excess ) {
$max_excess = $excess;
}
my $file_writer_object = $self->[_file_writer_object_];
my $last_outdented_line_at =
$file_writer_object->get_output_line_number();
- $self->[_last_outdented_line_at_] = $last_outdented_line_at;
+ my $nlines = @{$rgroup_lines};
+ $self->[_last_outdented_line_at_] =
+ $last_outdented_line_at + $nlines - 1;
my $outdented_line_count = $self->[_outdented_line_count_];
unless ($outdented_line_count) {
$self->[_first_outdented_line_at_] = $last_outdented_line_at;
}
- my $nlines = @{$rgroup_lines};
$outdented_line_count += $nlines;
$self->[_outdented_line_count_] = $outdented_line_count;
}
line_length => $str_len,
side_comment_length => 0,
outdent_long_lines => $outdent_long_lines,
- rvertical_tightness_flags => "",
+ rvertical_tightness_flags => undef,
level => $group_level,
level_end => $group_level,
Kend => $Kend,
+ maximum_line_length => $group_maximum_line_length,
}
);
}
# $level_jump = $next_level-$group_level, if known
# = undef if not known
+ # Note: only the sign of the jump is needed
my $rgroup_lines = $self->[_rgroup_lines_];
return unless ( @{$rgroup_lines} );
: 0;
# STEP 6: Output the lines.
- # All lines in this batch have the same basic leading spacing:
+ # All lines in this group have the same leading spacing and maximum line
+ # length
my $group_leader_length = $rgroup_lines->[0]->get_leading_space_count();
+ my $group_maximum_line_length =
+ $rgroup_lines->[0]->get_maximum_line_length();
foreach my $line ( @{$rgroup_lines} ) {
$self->valign_output_step_A(
group_leader_length => $group_leader_length,
extra_leading_spaces => $extra_leading_spaces,
level => $group_level,
+ maximum_line_length => $group_maximum_line_length,
}
);
}
+ # Let the formatter know that this object has been processed and any
+ # recoverable spaces have been handled. This is needed for setting the
+ # closing paren location in -lp mode.
+ my $object = $rgroup_lines->[0]->get_indentation();
+ if ( ref($object) ) { $object->set_recoverable_spaces(0) }
+
$self->initialize_for_new_group();
return;
}
if ( !defined($jbeg) ) {
# safety check, shouldn't happen
- $self->warning(<<EOM);
+ warning(<<EOM);
Program bug detected in Perl::Tidy::VerticalAligner sub sweep_top_down
undefined index for group line count $group_line_count
EOM
# If this line has no matching tokens, then flush out the lines
# BEFORE this line unless both it and the previous line have side
- # comments. This prevents this line from pushing side coments out
+ # comments. This prevents this line from pushing side comments out
# to the right.
elsif ( $new_line->get_jmax() == 1 ) {
# two isolated (list) lines
# imax_min = number of common alignment tokens
# Return:
- # $pad_max = maximum suggested pad distnce
+ # $pad_max = maximum suggested pad distance
# = 0 if alignment not recommended
# Note that this is only for two lines which do not have alignment tokens
# in common with any other lines. It is intended for lists, but it might
my $lensum_m = 0;
my $lensum = 0;
- for ( my $i = 0 ; $i <= $imax_min ; $i++ ) {
+ foreach my $i ( 0 .. $imax_min ) {
$lensum_m += $rfield_lengths_m->[$i];
$lensum += $rfield_lengths->[$i];
}
$patterns_match = 1;
my $rpatterns_m = $line_m->get_rpatterns();
my $rpatterns = $line->get_rpatterns();
- for ( my $i = 0 ; $i <= $imax_min ; $i++ ) {
+ foreach my $i ( 0 .. $imax_min ) {
my $pat = $rpatterns->[$i];
my $pat_m = $rpatterns_m->[$i];
if ( $pat ne $pat_m ) { $patterns_match = 0; last }
# spot to take special action on failure to move
}
}
+ return;
};
foreach my $task ( @{$rtodo} ) {
# my $unknown6 = pack( "VV", 0x00, 0x1000 );
# On the other hand, it is okay to keep matching at the same
- # level such as in a simple list of commas and/or fat arrors.
+ # level such as in a simple list of commas and/or fat commas.
my $is_blocked = defined( $blocking_level[$ng] )
&& $lev > $blocking_level[$ng];
# Do not let one or two lines with a **different number of
# alignments** open up a big gap in a large block. For
# example, we will prevent something like this, where the first
- # line prys open the rest:
+ # line pries open the rest:
# $worksheet->write( "B7", "http://www.perl.com", undef, $format );
# $worksheet->write( "C7", "", $format );
use constant EXPLAIN_DELETE_SELECTED => 0;
- local $" = '> <';
+ local $LIST_SEPARATOR = '> <';
EXPLAIN_DELETE_SELECTED && print <<EOM;
delete indexes: <@{$ridel}>
old jmax: $jmax_old
my %delete_me;
@delete_me{ @{$ridel} } = (1) x scalar( @{$ridel} );
- my $pattern = $rpatterns_old->[0];
- my $field = $rfields_old->[0];
- my $field_length = $rfield_lengths_old->[0];
- push @{$rfields_new}, $field;
- push @{$rfield_lengths_new}, $field_length;
- push @{$rpatterns_new}, $pattern;
+ my $pattern_0 = $rpatterns_old->[0];
+ my $field_0 = $rfields_old->[0];
+ my $field_length_0 = $rfield_lengths_old->[0];
+ push @{$rfields_new}, $field_0;
+ push @{$rfield_lengths_new}, $field_length_0;
+ push @{$rpatterns_new}, $pattern_0;
# Loop to either copy items or concatenate fields and patterns
my $jmin_del;
- for ( my $j = 0 ; $j < $jmax_old ; $j++ ) {
+ foreach my $j ( 0 .. $jmax_old - 1 ) {
my $token = $rtokens_old->[$j];
my $field = $rfields_old->[ $j + 1 ];
my $field_length = $rfield_lengths_old->[ $j + 1 ];
# An existing list will still be a list but with possibly different
# leading token
my $old_list_type = $line_obj->get_list_type();
- my $new_list_type = "";
+ my $new_list_type = EMPTY_STRING;
if ( $rtokens_new->[0] =~ /^(=>|,)/ ) {
$new_list_type = $rtokens_new->[0];
}
return @{ $decoded_token{$tok} };
}
- my ( $raw_tok, $lev, $tag, $tok_count ) = ( $tok, 0, "", 1 );
+ my ( $raw_tok, $lev, $tag, $tok_count ) = ( $tok, 0, EMPTY_STRING, 1 );
if ( $tok =~ /^(\D+)(\d+)([^\.]*)(\.(\d+))?$/ ) {
$raw_tok = $1;
$lev = $2;
my @equals_info;
my @line_info;
- my %is_good_tok;
# create a hash of tokens for each line
my $rline_hashes = [];
$i++;
}
push @{$rline_hashes}, $rhash;
- push @equals_info, [ $i_eq, $tok_eq, $pat_eq ];
- push @line_info, [ $lev_min, $lev_max ];
+ push @equals_info, [ $i_eq, $tok_eq, $pat_eq ];
+ push @line_info, [ $lev_min, $lev_max ];
if ( defined($lev_min) ) {
my $lev_diff = $lev_max - $lev_min;
if ( $lev_diff > $max_lev_diff ) { $max_lev_diff = $lev_diff }
# compare each line pair and record matches
my $rtok_hash = {};
my $nr = 0;
- for ( my $jl = 0 ; $jl < $jmax ; $jl++ ) {
+ foreach my $jl ( 0 .. $jmax - 1 ) {
my $nl = $nr;
$nr = 0;
my $jr = $jl + 1;
# find subgroups
my @subgroups;
push @subgroups, [ 0, $jmax ];
- for ( my $jl = 0 ; $jl < $jmax ; $jl++ ) {
+ foreach my $jl ( 0 .. $jmax - 1 ) {
if ( $rnew_lines->[$jl]->get_end_group() ) {
$subgroups[-1]->[1] = $jl;
push @subgroups, [ $jl + 1, $jmax ];
my %token_line_count;
if ( $nlines > 2 ) {
- for ( my $jj = $jbeg ; $jj <= $jend ; $jj++ ) {
+ foreach my $jj ( $jbeg .. $jend ) {
my %seen;
my $line = $rnew_lines->[$jj];
my $rtokens = $line->get_rtokens();
#####################################################
# Loop over lines to remove unwanted alignment tokens
#####################################################
- for ( my $jj = $jbeg ; $jj <= $jend ; $jj++ ) {
+ foreach my $jj ( $jbeg .. $jend ) {
my $line = $rnew_lines->[$jj];
my $rtokens = $line->get_rtokens();
my $rhash = $rline_hashes->[$jj];
my $delete_above_level;
my $deleted_assignment_token;
- my $saw_dividing_token = "";
+ my $saw_dividing_token = EMPTY_STRING;
$saw_large_group ||= $nlines > 2 && $imax > 1;
# Loop over all alignment tokens
- for ( my $i = 0 ; $i <= $imax ; $i++ ) {
+ foreach my $i ( 0 .. $imax ) {
my $tok = $rtokens->[$i];
next if ( $tok eq '#' ); # shouldn't happen
my ( $iii, $il, $ir, $raw_tok, $lev, $tag, $tok_count ) =
#######################################################
my $delete_me = !defined($il) && !defined($ir);
+ # Apply any user controls. Note that not all lines pass
+ # this way so they have to be applied elsewhere too.
+ my $align_ok = 1;
+ if (%valign_control_hash) {
+ $align_ok = $valign_control_hash{$raw_tok};
+ $align_ok = $valign_control_default
+ unless defined($align_ok);
+ $delete_me ||= !$align_ok;
+ }
+
# But now we modify this with exceptions...
# EXCEPTION 1: If we are in a complete ternary or
# will now be incorrect. For example, this will prevent
# aligning commas as follows after deleting the second '=>'
# $w->insert(
- # ListBox => origin => [ 270, 160 ],
- # size => [ 200, 55 ],
+ # ListBox => origin => [ 270, 160 ],
+ # size => [ 200, 55 ],
# );
if ( defined($delete_above_level) ) {
if ( $lev > $delete_above_level ) {
}
}
+ # Do not let a user exclusion be reactivated by above rules
+ $delete_me ||= !$align_ok;
+
#####################################
# Add this token to the deletion list
#####################################
$j_match_end = $jj;
# Keep track of any padding that would be needed for each token
- for ( my $i = 0 ; $i <= $imax ; $i++ ) {
+ foreach my $i ( 0 .. $imax ) {
next if ( $rneed_pad->[$i] );
my $length = $rfield_lengths->[$i];
my $length_match = $rfield_lengths_match->[$i];
if ( $length ne $length_match ) { $rneed_pad->[$i] = 1 }
}
+ return;
};
my $end_match = sub {
);
# Note that we are skipping the token at i=0
- for ( my $i = 1 ; $i <= $imax_match ; $i++ ) {
+ foreach my $i ( 1 .. $imax_match ) {
# do not delete a token which requires padding to align
next if ( $rneed_pad->[$i] );
delete_selected_tokens( $rnew_lines->[$j], \@idel );
}
}
+ return;
};
foreach my $item ( @{$rsubgroups} ) {
my $nlines = $jend - $jbeg + 1;
next unless ( $nlines > 2 );
- for ( my $jj = $jbeg ; $jj <= $jend ; $jj++ ) {
+ foreach my $jj ( $jbeg .. $jend ) {
my $line = $rnew_lines->[$jj];
$rtokens = $line->get_rtokens();
$rfield_lengths = $line->get_rfield_lengths();
# see if all tokens of this line match the current group
my $match;
if ( $imax == $imax_match ) {
- for ( my $i = 0 ; $i <= $imax ; $i++ ) {
+ foreach my $i ( 0 .. $imax ) {
my $tok = $rtokens->[$i];
my $tok_match = $rtokens_match->[$i];
last if ( $tok ne $tok_match );
# 2 = no match, and lines do not match at all
my ( $tok, $tok_m, $pat, $pat_m, $pad ) = @_;
- my $GoToMsg = "";
+ my $GoToMsg = EMPTY_STRING;
my $return_code = 1;
my ( $alignment_token, $lev, $tag, $tok_count ) =
# left with scalars on the left. We will also prevent
# any partial alignments.
- # set return code 2 if the = is at line level, but
- # set return code 1 if the = is below line level, i.e.
- # sub new { my ( $p, $v ) = @_; bless \$v, $p }
- # sub iter { my ($x) = @_; return undef if $$x < 0; return $$x--; }
+ # set return code 2 if the = is at line level, but
+ # set return code 1 if the = is below line level, i.e.
+ # sub new { my ( $p, $v ) = @_; bless \$v, $p }
+ # sub iter { my ($x) = @_; return undef if $$x < 0; return $$x--; }
elsif (
( index( $pat_m, ',' ) >= 0 ) ne ( index( $pat, ',' ) >= 0 ) )
next unless ( $nlines > 1 );
# loop over lines in a subgroup
- for ( my $jj = $jbeg ; $jj <= $jend ; $jj++ ) {
+ foreach my $jj ( $jbeg .. $jend ) {
$line_m = $line;
$rtokens_m = $rtokens;
if ($ci_jump) { $imax_min = -1 }
my $i_nomatch = $imax_min + 1;
- for ( my $i = 0 ; $i <= $imax_min ; $i++ ) {
+ foreach my $i ( 0 .. $imax_min ) {
my $tok = $rtokens->[$i];
my $tok_m = $rtokens_m->[$i];
if ( $tok ne $tok_m ) {
##################
else {
my $i_nomatch = $imax_min + 1;
- for ( my $i = 0 ; $i <= $imax_min ; $i++ ) {
+ foreach my $i ( 0 .. $imax_min ) {
my $tok = $rtokens->[$i];
my $tok_m = $rtokens_m->[$i];
if ( $tok ne $tok_m ) {
$tok, $tok_m, $pat, $pat_m, $pad
);
if ($match_code) {
- if ( $match_code eq 1 ) { $i_nomatch = $i }
- elsif ( $match_code eq 2 ) { $i_nomatch = 0 }
+ if ( $match_code == 1 ) { $i_nomatch = $i }
+ elsif ( $match_code == 2 ) { $i_nomatch = 0 }
last;
}
}
# $$d{"hours"} = [ "h", "hr", "hrs", "hour", "hours" ];
my @all_token_info;
my $all_monotonic = 1;
- for ( my $jj = 0 ; $jj < @{$rlines} ; $jj++ ) {
+ foreach my $jj ( 0 .. @{$rlines} - 1 ) {
my ($line) = $rlines->[$jj];
my $rtokens = $line->get_rtokens();
my $last_lev;
}
my $rline_values = [];
- for ( my $jj = 0 ; $jj < @{$rlines} ; $jj++ ) {
+ foreach my $jj ( 0 .. @{$rlines} - 1 ) {
my ($line) = $rlines->[$jj];
my $rtokens = $line->get_rtokens();
my $i = -1;
my ( $lev_min, $lev_max );
- my $token_pattern_max = "";
+ my $token_pattern_max = EMPTY_STRING;
my %saw_level;
- my @token_info;
my $is_monotonic = 1;
# find the index of the last token before the side comment
my $tok_end = fat_comma_to_comma( $rtokens->[$imax] );
if ( $all_monotonic && $tok_end =~ /^,/ ) {
- my $i = $imax - 1;
- while ( $i >= 0
- && fat_comma_to_comma( $rtokens->[$i] ) eq $tok_end )
+ my $ii = $imax - 1;
+ while ( $ii >= 0
+ && fat_comma_to_comma( $rtokens->[$ii] ) eq $tok_end )
{
- $imax = $i;
- $i--;
+ $imax = $ii;
+ $ii--;
}
}
$lev_min = -1;
$lev_max = -1;
$levs[0] = -1;
- $rtoken_patterns->{$lev_min} = "";
+ $rtoken_patterns->{$lev_min} = EMPTY_STRING;
$rtoken_indexes->{$lev_min} = [];
}
# debug
0 && do {
- local $" = ')(';
+ local $LIST_SEPARATOR = ')(';
print "lev_min=$lev_min, lev_max=$lev_max, levels=(@levs)\n";
foreach my $key ( sort keys %{$rtoken_patterns} ) {
print "$key => $rtoken_patterns->{$key}\n";
# );
# In the above example, all lines have three commas at the lowest depth
- # (zero), so if there were no other alignements, these lines would all
+ # (zero), so if there were no other alignments, these lines would all
# align considering only the zero depth alignment token. But some lines
# have additional comma alignments at the next depth, so we need to decide
# if we should drop those to keep the top level alignments, or keep those
######################################################
# Prune Tree Step 2. Loop to form the tree of matches.
######################################################
- for ( my $jp = 0 ; $jp <= $jmax ; $jp++ ) {
+ foreach my $jp ( 0 .. $jmax ) {
# working with two adjacent line indexes, 'm'=minus, 'p'=plus
my $jm = $jp - 1;
$levels_next[$MAX_DEPTH] = $rlevs->[-1];
}
my $depth = 0;
- foreach (@levels_next) {
+ foreach my $item (@levels_next) {
$token_patterns_next[$depth] =
- defined($_) ? $rtoken_patterns->{$_} : undef;
+ defined($item) ? $rtoken_patterns->{$item} : undef;
$token_indexes_next[$depth] =
- defined($_) ? $rtoken_indexes->{$_} : undef;
+ defined($item) ? $rtoken_indexes->{$item} : undef;
$depth++;
}
# construction. The children nodes have links up to the parent node which
# created them. Now make links in the opposite direction, so the parents
# can find the children. We store the range of children nodes ($nc_beg,
- # $nc_end) of each parent with two additional indexes in the orignal array.
+ # $nc_end) of each parent with two additional indexes in the original array.
# These will be undef if no children.
- for ( my $depth = $MAX_DEPTH ; $depth > 0 ; $depth-- ) {
+ foreach my $depth ( reverse( 1 .. $MAX_DEPTH ) ) {
next unless defined( $match_tree[$depth] );
my $nc_max = @{ $match_tree[$depth] } - 1;
my $np_now;
# $level_keep is the minimum level to keep
my @delete_list;
+ # Not currently used:
# Groups with ending comma lists and their range of sizes:
# $ragged_comma_group{$id} = [ imax_group_min, imax_group_max ]
- my %ragged_comma_group;
+ ## my %ragged_comma_group;
# Define a threshold line count for forcing a break
my $nlines_break = 3;
@todo_list = ( 0 .. @{ $match_tree[0] } - 1 );
}
- for ( my $depth = 0 ; $depth <= $MAX_DEPTH ; $depth++ ) {
+ foreach my $depth ( 0 .. $MAX_DEPTH ) {
last unless (@todo_list);
my @todo_next;
foreach my $np (@todo_list) {
my @idel;
my $rtokens = $line->get_rtokens();
my $imax = @{$rtokens} - 2;
- for ( my $i = 0 ; $i <= $imax ; $i++ ) {
+ foreach my $i ( 0 .. $imax ) {
my $tok = $rtokens->[$i];
my ( $raw_tok, $lev, $tag, $tok_count ) =
decode_alignment_token($tok);
sub Dump_tree_groups {
my ( $rgroup, $msg ) = @_;
print "$msg\n";
- local $" = ')(';
+ local $LIST_SEPARATOR = ')(';
foreach my $item ( @{$rgroup} ) {
my @fix = @{$item};
- foreach (@fix) { $_ = "undef" unless defined $_; }
+ foreach my $val (@fix) { $val = "undef" unless defined $val; }
$fix[4] = "...";
print "(@fix)\n";
}
# it seems that the an alignment would look bad.
my $max_pad = 0;
my $saw_good_alignment = 0;
- my $saw_if_or; # if we saw an 'if' or 'or' at group level
- my $raw_tokb = ""; # first token seen at group level
+ my $saw_if_or; # if we saw an 'if' or 'or' at group level
+ my $raw_tokb = EMPTY_STRING; # first token seen at group level
my $jfirst_bad;
my $line_ending_fat_comma; # is last token just a '=>' ?
my $j0_eq_pad;
my $j0_max_pad = 0;
- for ( my $j = 0 ; $j < $jmax_1 - 1 ; $j++ ) {
+ foreach my $j ( 0 .. $jmax_1 - 2 ) {
my ( $raw_tok, $lev, $tag, $tok_count ) =
decode_alignment_token( $rtokens_1->[$j] );
if ( $raw_tok && $lev == $group_level ) {
my $short_diff = SC_LONG_LINE_DIFF / ( 1 + $alev_diff * $num5 );
goto FORGET
- if ( $line_diff > $short_diff );
+ if ( $line_diff > $short_diff
+ || !$self->[_rOpts_valign_side_comments_] );
# RULE3: Forget a side comment if this line is at lower level and
# ends a block
# and fake side comments. This has the consequence that the lengths of
# long lines without real side comments can cause 'push' all side comments
# to the right. This seems unusual, but testing with and without this
- # feature shows that it is usually better this way. Othewise, side
+ # feature shows that it is usually better this way. Otherwise, side
# comments can be hidden between long lines without side comments and
# thus be harder to read.
# Count $num5 = number of comments in the 5 lines after the first comment
# This is an important factor in a decision formula
my $num5 = 1;
- for ( my $jj = $j_sc_beg + 1 ; $jj < @{$rlines} ; $jj++ ) {
+ foreach my $jj ( $j_sc_beg + 1 .. @{$rlines} - 1 ) {
my $ldiff = $jj - $j_sc_beg;
last if ( $ldiff > 5 );
my $line = $rlines->[$jj];
}
# Forget the old side comment location if necessary
- my $line = $rlines->[$j_sc_beg];
+ my $line_0 = $rlines->[$j_sc_beg];
my $lnum =
$j_sc_beg + $self->[_file_writer_object_]->get_output_line_number();
my $keep_it =
- $self->is_good_side_comment_column( $line, $lnum, $group_level, $num5 );
+ $self->is_good_side_comment_column( $line_0, $lnum, $group_level, $num5 );
my $last_side_comment_column =
$keep_it ? $self->[_last_side_comment_column_] : 0;
# Loop over passes
my $max_comment_column = $last_side_comment_column;
- for ( my $PASS = 1 ; $PASS <= $MAX_PASS ; $PASS++ ) {
+ foreach my $PASS ( 1 .. $MAX_PASS ) {
# If there are two passes, then on the last pass make the old column
# equal to the largest of the group. This will result in the comments
my $j_sc_last;
my $ng_last = $todo[-1];
my ( $jbeg, $jend ) = @{ $rgroups->[$ng_last] };
- for ( my $jj = $jend ; $jj >= $jbeg ; $jj-- ) {
+ foreach my $jj ( reverse( $jbeg .. $jend ) ) {
my $line = $rlines->[$jj];
my $jmax = $line->get_jmax();
if ( $line->get_rfield_lengths()->[$jmax] ) {
my $group_leader_length = $rinput_hash->{group_leader_length};
my $extra_leading_spaces = $rinput_hash->{extra_leading_spaces};
my $level = $rinput_hash->{level};
+ my $maximum_line_length = $rinput_hash->{maximum_line_length};
my $rfields = $line->get_rfields();
my $rfield_lengths = $line->get_rfield_lengths();
# only add padding when we have a finite field;
# this avoids extra terminal spaces if we have empty fields
if ( $rfield_lengths->[$j] > 0 ) {
- $str .= ' ' x $total_pad_count;
+ $str .= SPACE x $total_pad_count;
$str_len += $total_pad_count;
$total_pad_count = 0;
$str .= $rfields->[$j];
level => $level,
level_end => $level_end,
Kend => $Kend,
+ maximum_line_length => $maximum_line_length,
}
);
return;
my $cached_line_text;
my $cached_line_text_length;
my $cached_line_type;
- my $cached_line_flag;
+ my $cached_line_opening_flag;
+ my $cached_line_closing_flag;
my $cached_seqno;
my $cached_line_valid;
my $cached_line_leading_space_count;
my $cached_seqno_string;
my $cached_line_Kend;
+ my $cached_line_maximum_length;
+
+ # These are passed to step_C:
my $seqno_string;
my $last_nonblank_seqno_string;
- sub get_seqno_string {
- return $seqno_string;
- }
-
- sub get_last_nonblank_seqno_string {
- return $last_nonblank_seqno_string;
- }
-
sub set_last_nonblank_seqno_string {
my ($val) = @_;
$last_nonblank_seqno_string = $val;
return;
}
- sub get_cached_line_flag {
- return $cached_line_flag;
+ sub get_cached_line_opening_flag {
+ return $cached_line_opening_flag;
}
sub get_cached_line_type {
sub initialize_step_B_cache {
# valign_output_step_B cache:
- $cached_line_text = "";
+ $cached_line_text = EMPTY_STRING;
$cached_line_text_length = 0;
$cached_line_type = 0;
- $cached_line_flag = 0;
+ $cached_line_opening_flag = 0;
+ $cached_line_closing_flag = 0;
$cached_seqno = 0;
$cached_line_valid = 0;
$cached_line_leading_space_count = 0;
- $cached_seqno_string = "";
+ $cached_seqno_string = EMPTY_STRING;
$cached_line_Kend = undef;
+ $cached_line_maximum_length = undef;
# These vars hold a string of sequence numbers joined together used by
# the cache
- $seqno_string = "";
- $last_nonblank_seqno_string = "";
+ $seqno_string = EMPTY_STRING;
+ $last_nonblank_seqno_string = EMPTY_STRING;
return;
}
if ($cached_line_type) {
$seqno_string = $cached_seqno_string;
$self->valign_output_step_C(
+ $seqno_string,
+ $last_nonblank_seqno_string,
+
$cached_line_text,
$cached_line_leading_space_count,
$self->[_last_level_written_],
$cached_line_Kend,
);
- $cached_line_type = 0;
- $cached_line_text = "";
- $cached_line_text_length = 0;
- $cached_seqno_string = "";
- $cached_line_Kend = undef;
+ $cached_line_type = 0;
+ $cached_line_text = EMPTY_STRING;
+ $cached_line_text_length = 0;
+ $cached_seqno_string = EMPTY_STRING;
+ $cached_line_Kend = undef;
+ $cached_line_maximum_length = undef;
}
return;
}
my $level = $rinput->{level};
my $level_end = $rinput->{level_end};
my $Kend = $rinput->{Kend};
+ my $maximum_line_length = $rinput->{maximum_line_length};
my $last_level_written = $self->[_last_level_written_];
$str_length -
$side_comment_length +
$leading_space_count -
- $self->maximum_line_length_for_level($level);
+ $maximum_line_length;
if ( $excess > 0 ) {
$leading_space_count = 0;
my $file_writer_object = $self->[_file_writer_object_];
# later by entabbing, so we have to keep track of any changes
# to the leading_space_count from here on.
my $leading_string =
- $leading_space_count > 0 ? ( ' ' x $leading_space_count ) : "";
+ $leading_space_count > 0
+ ? ( SPACE x $leading_space_count )
+ : EMPTY_STRING;
my $leading_string_length = length($leading_string);
# Unpack any recombination data; it was packed by
- # sub send_lines_to_vertical_aligner. Contents:
+ # sub 'Formatter::set_vertical_tightness_flags'
+
+ # old hash Meaning
+ # index key
#
- # [0] type: 1=opening non-block 2=closing non-block
- # 3=opening block brace 4=closing block brace
- # [1] flag: if opening: 1=no multiple steps, 2=multiple steps ok
- # if closing: spaces of padding to use
- # [2] sequence number of container
- # [3] valid flag: do not append if this flag is false
+ # 0 _vt_type: 1=opening non-block 2=closing non-block
+ # 3=opening block brace 4=closing block brace
#
- my ( $open_or_close, $tightness_flag, $seqno, $valid, $seqno_beg,
- $seqno_end );
+ # 1a _vt_opening_flag: 1=no multiple steps, 2=multiple steps ok
+ # 1b _vt_closing_flag: spaces of padding to use if closing
+ # 2 _vt_seqno: sequence number of container
+ # 3 _vt_valid flag: do not append if this flag is false. Will be
+ # true if appropriate -vt flag is set. Otherwise, Will be
+ # made true only for 2 line container in parens with -lp
+ # 4 _vt_seqno_beg: sequence number of first token of line
+ # 5 _vt_seqno_end: sequence number of last token of line
+ # 6 _vt_min_lines: min number of lines for joining opening cache,
+ # 0=no constraint
+ # 7 _vt_max_lines: max number of lines for joining opening cache,
+ # 0=no constraint
+
+ my ( $open_or_close, $opening_flag, $closing_flag, $seqno, $valid,
+ $seqno_beg, $seqno_end );
if ($rvertical_tightness_flags) {
- (
- $open_or_close, $tightness_flag, $seqno, $valid, $seqno_beg,
- $seqno_end
- ) = @{$rvertical_tightness_flags};
+
+ $open_or_close = $rvertical_tightness_flags->{_vt_type};
+ $opening_flag = $rvertical_tightness_flags->{_vt_opening_flag};
+ $closing_flag = $rvertical_tightness_flags->{_vt_closing_flag};
+ $seqno = $rvertical_tightness_flags->{_vt_seqno};
+ $valid = $rvertical_tightness_flags->{_vt_valid_flag};
+ $seqno_beg = $rvertical_tightness_flags->{_vt_seqno_beg};
+ $seqno_end = $rvertical_tightness_flags->{_vt_seqno_end};
}
$seqno_string = $seqno_end;
# Dump an invalid cached line
if ( !$cached_line_valid ) {
$self->valign_output_step_C(
- $cached_line_text, $cached_line_leading_space_count,
- $last_level_written, $cached_line_Kend
+ $seqno_string,
+ $last_nonblank_seqno_string,
+
+ $cached_line_text,
+ $cached_line_leading_space_count,
+ $last_level_written,
+ $cached_line_Kend
);
}
my $gap = $leading_space_count - $cached_line_text_length;
# handle option of just one tight opening per line:
- if ( $cached_line_flag == 1 ) {
+ if ( $cached_line_opening_flag == 1 ) {
if ( defined($open_or_close) && $open_or_close == 1 ) {
$gap = -1;
}
# and breaks, causing -xci to alternately turn on and off (case
# b765).
# Patched to fix cases b656 b862 b971 b972: always do the check
- # if -vmll is set. The reason is that the -vmll option can
- # cause changes in the maximum line length, leading to blinkers
- # if not checked.
+ # if the maximum line length changes (due to -vmll).
if (
$gap >= 0
- && ( $self->[_rOpts_variable_maximum_line_length_]
+ && ( $maximum_line_length != $cached_line_maximum_length
|| ( defined($level_end) && $level > $level_end ) )
)
{
my $test_line_length =
$cached_line_text_length + $gap + $str_length;
- my $maximum_line_length =
- $self->maximum_line_length_for_level($last_level_written);
# Add a small tolerance in the length test (fixes case b862)
- if ( $test_line_length > $maximum_line_length - 2 ) {
+ if ( $test_line_length > $cached_line_maximum_length - 2 ) {
$gap = -1;
}
}
if ( $gap >= 0 && defined($seqno_beg) ) {
- $leading_string = $cached_line_text . ' ' x $gap;
+ $maximum_line_length = $cached_line_maximum_length;
+ $leading_string = $cached_line_text . SPACE x $gap;
$leading_string_length = $cached_line_text_length + $gap;
$leading_space_count = $cached_line_leading_space_count;
$seqno_string = $cached_seqno_string . ':' . $seqno_beg;
}
else {
$self->valign_output_step_C(
- $cached_line_text, $cached_line_leading_space_count,
- $last_level_written, $cached_line_Kend
+ $seqno_string,
+ $last_nonblank_seqno_string,
+
+ $cached_line_text,
+ $cached_line_leading_space_count,
+ $last_level_written,
+ $cached_line_Kend
);
}
}
# Handle cached line ending in CLOSING tokens
else {
my $test_line =
- $cached_line_text . ' ' x $cached_line_flag . $str;
+ $cached_line_text . SPACE x $cached_line_closing_flag . $str;
my $test_line_length =
- $cached_line_text_length + $cached_line_flag + $str_length;
+ $cached_line_text_length +
+ $cached_line_closing_flag +
+ $str_length;
if (
# The new line must start with container
)
# The combined line must fit
- && (
- $test_line_length <=
- $self->maximum_line_length_for_level(
- $last_level_written)
- )
+ && ( $test_line_length <= $cached_line_maximum_length )
)
{
}
}
+ # Change the args to look like we received the combined line
$str = $test_line;
$str_length = $test_line_length;
- $leading_string = "";
+ $leading_string = EMPTY_STRING;
$leading_string_length = 0;
$leading_space_count = $cached_line_leading_space_count;
$level = $last_level_written;
+ $maximum_line_length = $cached_line_maximum_length;
}
else {
$self->valign_output_step_C(
- $cached_line_text, $cached_line_leading_space_count,
- $last_level_written, $cached_line_Kend
+ $seqno_string,
+ $last_nonblank_seqno_string,
+
+ $cached_line_text,
+ $cached_line_leading_space_count,
+ $last_level_written,
+ $cached_line_Kend
);
}
}
}
- $cached_line_type = 0;
- $cached_line_text = "";
- $cached_line_text_length = 0;
- $cached_line_Kend = undef;
+ $cached_line_type = 0;
+ $cached_line_text = EMPTY_STRING;
+ $cached_line_text_length = 0;
+ $cached_line_Kend = undef;
+ $cached_line_maximum_length = undef;
# make the line to be written
my $line = $leading_string . $str;
# fix for case b999: do not cache an outdented line
if ( !$open_or_close || $side_comment_length > 0 || $is_outdented_line )
{
- $self->valign_output_step_C( $line, $leading_space_count, $level,
- $Kend );
+ $self->valign_output_step_C(
+ $seqno_string,
+ $last_nonblank_seqno_string,
+
+ $line,
+ $leading_space_count,
+ $level,
+ $Kend
+ );
}
else {
$cached_line_text = $line;
$cached_line_text_length = $line_length;
$cached_line_type = $open_or_close;
- $cached_line_flag = $tightness_flag;
+ $cached_line_opening_flag = $opening_flag;
+ $cached_line_closing_flag = $closing_flag;
$cached_seqno = $seqno;
$cached_line_valid = $valid;
$cached_line_leading_space_count = $leading_space_count;
$cached_seqno_string = $seqno_string;
$cached_line_Kend = $Kend;
+ $cached_line_maximum_length = $maximum_line_length;
}
$self->[_last_level_written_] = $level;
sub initialize_valign_buffer {
@valign_buffer = ();
- $valign_buffer_filling = "";
+ $valign_buffer_filling = EMPTY_STRING;
return;
}
}
@valign_buffer = ();
}
- $valign_buffer_filling = "";
+ $valign_buffer_filling = EMPTY_STRING;
return;
}
# The reason for storing lines is that we may later want to reduce their
# indentation when -sot and -sct are both used.
###############################################################
- my ( $self, @args ) = @_;
+ my (
+ $self,
+ $seqno_string,
+ $last_nonblank_seqno_string,
- my $seqno_string = get_seqno_string();
- my $last_nonblank_seqno_string = get_last_nonblank_seqno_string();
+ @args_to_D
+ ) = @_;
# Dump any saved lines if we see a line with an unbalanced opening or
# closing token.
# Either store or write this line
if ($valign_buffer_filling) {
- push @valign_buffer, [@args];
+ push @valign_buffer, [@args_to_D];
}
else {
- $self->valign_output_step_D(@args);
+ $self->valign_output_step_D(@args_to_D);
}
# For lines starting or ending with opening or closing tokens..
# opening tokens.
# patch for RT #94354, requested by Colin Williams
if ( $seqno_string =~ /^\d+(\:+\d+)+$/
- && $args[0] !~ /^[\}\)\]\:\?]/ )
+ && $args_to_D[0] !~ /^[\}\)\]\:\?]/ )
{
# This test is efficient but a little subtle: The first test
# Here is a complex example:
# Foo($Bar[0], { # (side comment)
- # baz => 1,
+ # baz => 1,
# });
# The first line has sequence 6::4. It does not begin with
$leading_space_count % $rOpts_entab_leading_whitespace;
my $tab_count =
int( $leading_space_count / $rOpts_entab_leading_whitespace );
- my $leading_string = "\t" x $tab_count . ' ' x $space_count;
+ my $leading_string = "\t" x $tab_count . SPACE x $space_count;
if ( $line =~ /^\s{$leading_space_count,$leading_space_count}/ ) {
substr( $line, 0, $leading_space_count ) = $leading_string;
}
# shouldn't happen - program error counting whitespace
# - skip entabbing
DEBUG_TABS
- && $self->warning(
+ && warning(
"Error entabbing in valign_output_step_D: expected count=$leading_space_count\n"
);
}
# But it could be an outdented comment
if ( $line !~ /^\s*#/ ) {
DEBUG_TABS
- && $self->warning(
+ && warning(
"Error entabbing in valign_output_step_D: for level=$level count=$leading_space_count\n"
);
}
- $leading_string = ( ' ' x $leading_space_count );
+ $leading_string = ( SPACE x $leading_space_count );
}
else {
- $leading_string .= ( ' ' x $space_count );
+ $leading_string .= ( SPACE x $space_count );
}
if ( $line =~ /^\s{$leading_space_count,$leading_space_count}/ ) {
substr( $line, 0, $leading_space_count ) = $leading_string;
# shouldn't happen - program error counting whitespace
# we'll skip entabbing
DEBUG_TABS
- && $self->warning(
+ && warning(
"Error entabbing in valign_output_step_D: expected count=$leading_space_count\n"
);
}
# Handle case of zero whitespace, which includes multi-line quotes
# (which may have a finite level; this prevents tab problems)
if ( $leading_whitespace_count <= 0 ) {
- return "";
+ return EMPTY_STRING;
}
# look for previous result
if ( !( $rOpts_tabs || $rOpts_entab_leading_whitespace )
|| $rOpts_indent_columns <= 0 )
{
- $leading_string = ( ' ' x $leading_whitespace_count );
+ $leading_string = ( SPACE x $leading_whitespace_count );
}
# Handle entab option
$leading_whitespace_count % $rOpts_entab_leading_whitespace;
my $tab_count = int(
$leading_whitespace_count / $rOpts_entab_leading_whitespace );
- $leading_string = "\t" x $tab_count . ' ' x $space_count;
+ $leading_string = "\t" x $tab_count . SPACE x $space_count;
}
# Handle option of one tab per level
# shouldn't happen:
if ( $space_count < 0 ) {
DEBUG_TABS
- && $self->warning(
+ && warning(
"Error in get_leading_string: for level=$group_level count=$leading_whitespace_count\n"
);
# -- skip entabbing
- $leading_string = ( ' ' x $leading_whitespace_count );
+ $leading_string = ( SPACE x $leading_whitespace_count );
}
else {
- $leading_string .= ( ' ' x $space_count );
+ $leading_string .= ( SPACE x $space_count );
}
}
$leading_string_cache[$leading_whitespace_count] = $leading_string;
return $leading_string;
}
-} # end get_leading_string
+} ## end get_leading_string
##########################
# CODE SECTION 10: Summary
my $outdented_line_count = $self->[_outdented_line_count_];
if ( $outdented_line_count > 0 ) {
- $self->write_logfile_entry(
+ write_logfile_entry(
"$outdented_line_count long lines were outdented:\n");
my $first_outdented_line_at = $self->[_first_outdented_line_at_];
- $self->write_logfile_entry(
+ write_logfile_entry(
" First at output line $first_outdented_line_at\n");
if ( $outdented_line_count > 1 ) {
my $last_outdented_line_at = $self->[_last_outdented_line_at_];
- $self->write_logfile_entry(
+ write_logfile_entry(
" Last at output line $last_outdented_line_at\n");
}
- $self->write_logfile_entry(
+ write_logfile_entry(
" use -noll to prevent outdenting, -l=n to increase line length\n"
);
- $self->write_logfile_entry("\n");
+ write_logfile_entry("\n");
}
return;
}
projects / perltidy.git / blobdiff