sub check_Q {
# Check that a quote looks okay
- # This sub works but needs to by sync'd with the log file output
- # before it can be used.
my ( $self, $KK, $Kfirst, $line_number ) = @_;
my $token = $rLL->[$KK]->[_TOKEN_];
$self->note_embedded_tab($line_number) if ( $token =~ "\t" );
my $type_0 = $rLL->[$Kfirst]->[_TYPE_];
if (
- ##$token =~ /^(s|tr|y|m|\/)/
- ##&& $previous_nonblank_token =~ /^(=|==|!=)$/
- 1
# preceded by simple scalar
- && $previous_nonblank_type_2 eq 'i'
+ $previous_nonblank_type_2 eq 'i'
&& $previous_nonblank_token_2 =~ /^\$/
# followed by some kind of termination
$rbreak_container->{$closing_seqno} = 1;
}
- # we will let the trailing block be either broken or intact
- ## && $is_broken_block->($opening_seqno);
-
# We can weld the closing brace to its following word ..
my $Ko = $K_closing_container->{$closing_seqno};
my $Kon;
# instead of -asbl, and this fixed most cases. But it turns out that
# the real problem was the -asbl flag, and switching to this was
# necessary to fixe b1268. This also fixes b1269, b1277, b1278.
- if (
- !$do_not_weld_rule
- ##&& $is_one_line_weld
+ if ( !$do_not_weld_rule
&& $rOpts_line_up_parentheses
&& $rOpts_asbl
- && $ris_asub_block->{$outer_seqno}
- )
+ && $ris_asub_block->{$outer_seqno} )
{
$do_not_weld_rule = '2A';
}
# Called before the start of each new batch
sub initialize_batch_variables {
- $max_index_to_go = UNDEFINED_INDEX;
- $summed_lengths_to_go[0] = 0;
- $nesting_depth_to_go[0] = 0;
- ##@summed_lengths_to_go = @nesting_depth_to_go = (0);
+ $max_index_to_go = UNDEFINED_INDEX;
+ $summed_lengths_to_go[0] = 0;
+ $nesting_depth_to_go[0] = 0;
$ri_starting_one_line_block = [];
# The initialization code for the remaining batch arrays is as follows
# give up if not on this line
return 0 unless ( $i_opening >= 0 );
- $i_start = $i_opening; ##$index_max_forced_break + 1;
+ $i_start = $i_opening;
# go back one token before the opening paren
if ( $i_start > 0 ) { $i_start-- }
$forced_breakpoint_count = 0;
$index_max_forced_break = UNDEFINED_INDEX;
$forced_breakpoint_undo_count = 0;
- ##@forced_breakpoint_undo_stack = (); # not needed
return;
}
if ( $ilast_nonblank >= 0 ) {
$inext_to_go[$ilast_nonblank] = $i;
-
- # just in case there are two blanks in a row (shouldn't
- # happen)
- if ( ++$ilast_nonblank < $i ) {
- $inext_to_go[$ilast_nonblank] = $i;
- }
}
$ilast_nonblank = $i;
- # This is a good spot to efficiently collect information needed
- # for breaking lines...
-
# gather info needed by sub break_long_lines
if ( $type_sequence_to_go[$i] ) {
my $seqno = $type_sequence_to_go[$i];
$last_nonblank_type = $type;
$last_nonblank_token = $token;
$last_nonblank_block_type = $block_type;
- } ## end if ( $type ne 'b' )
+ }
$type = $types_to_go[$i];
$block_type = $block_type_to_go[$i];
$token = $tokens_to_go[$i];
$want_previous_breakpoint = $i
unless ($skip);
- } ## end if ( $next_nonblank_type...)
+ }
} ## end if ($rOpts_break_at_old_keyword_breakpoints)
# Break before attributes if user broke there
)
{
$self->set_forced_breakpoint( $i - 1 );
- } ## end if ( $type eq 'k' && $i...)
+ }
# remember locations of '||' and '&&' for possible breaks if we
# decide this is a long logical expression.
++$has_old_logical_breakpoints[$depth]
if ( ( $i == $i_line_start || $i == $i_line_end )
&& $rOpts_break_at_old_logical_breakpoints );
- } ## end elsif ( $type eq '||' )
+ }
elsif ( $type eq '&&' ) {
push @{ $rand_or_list[$depth][3] }, $i;
++$has_old_logical_breakpoints[$depth]
if ( ( $i == $i_line_start || $i == $i_line_end )
&& $rOpts_break_at_old_logical_breakpoints );
- } ## end elsif ( $type eq '&&' )
+ }
elsif ( $type eq 'f' ) {
push @{ $rfor_semicolon_list[$depth] }, $i;
}
++$has_old_logical_breakpoints[$depth]
if ( ( $i == $i_line_start || $i == $i_line_end )
&& $rOpts_break_at_old_logical_breakpoints );
- } ## end if ( $token eq 'and' )
+ }
# break immediately at 'or's which are probably not in a logical
# block -- but we will break in logical breaks below so that
{
$saw_good_breakpoint = 1;
}
- } ## end else [ if ( $is_logical_container...)]
- } ## end elsif ( $token eq 'or' )
+ }
+ }
elsif ( $token eq 'if' || $token eq 'unless' ) {
push @{ $rand_or_list[$depth][4] }, $i;
if ( ( $i == $i_line_start || $i == $i_line_end )
{
$self->set_forced_breakpoint($i);
}
- } ## end elsif ( $token eq 'if' ||...)
- } ## end elsif ( $type eq 'k' )
+ }
+ }
elsif ( $is_assignment{$type} ) {
$i_equals[$depth] = $i;
}
$self->break_lists_increase_depth();
- } ## end if ( $depth > $current_depth)
+ }
#--------------------------
# Handle Decreasing Depth..
$comma_follows_last_closing_token =
$next_nonblank_type eq ',' || $next_nonblank_type eq '=>';
- } ## end elsif ( $depth < $current_depth)
+ }
#------------------
# Handle this token
$want_comma_break[$depth] = 1;
$index_before_arrow[$depth] = $i_last_nonblank_token;
next;
- } ## end if ( $type eq '=>' )
+ }
elsif ( $type eq '.' ) {
$last_dot_index[$depth] = $i;
$dont_align[$depth] = 1;
$want_comma_break[$depth] = 0;
$index_before_arrow[$depth] = -1;
- } ## end elsif ( ( $type =~ /^[\;\<\>\~]$/...))
+ }
# now just handle any commas
next unless ( $type eq ',' );
if ( $types_to_go[$ibreak] eq 'b' ) { $ibreak-- }
if ( $types_to_go[$ibreak] =~ /^[,wiZCUG\(\{\[]$/ ) {
- # don't break pointer calls, such as the following:
- # File::Spec->curdir => 1,
- # (This is tokenized as adjacent 'w' tokens)
- ##if ( $tokens_to_go[ $ibreak + 1 ] !~ /^->/ ) {
-
- # And don't break before a comma, as in the following:
+ # don't break before a comma, as in the following:
# ( LONGER_THAN,=> 1,
# EIGHTY_CHARACTERS,=> 2,
# CAUSES_FORMATTING,=> 3,
{
$self->set_forced_breakpoint($ibreak);
}
- } ## end if ( $types_to_go[$ibreak...])
- } ## end if ( $ibreak > 0 && $tokens_to_go...)
+ }
+ }
$want_comma_break[$depth] = 0;
$index_before_arrow[$depth] = -1;
# treat any list items so far as an interrupted list
$interrupted_list[$depth] = 1;
next;
- } ## end if ( $want_comma_break...)
+ }
# Break after all commas above starting depth...
# But only if the last closing token was followed by a comma,
{
$dont_align[$depth] = 1;
}
- } ## end if ( $item_count == 0 )
+ }
$comma_index[$depth][$item_count] = $i;
++$item_count_stack[$depth];
&& $i_old_assignment_break < $max_index_to_go )
{
$saw_good_breakpoint = 1;
- } ## end elsif ( $i_old_assignment_break...)
+ }
return $saw_good_breakpoint;
} ## end sub break_lists
$self->set_forced_breakpoint( $i_equals[$depth] );
$i_equals[$depth] = -1;
}
- } ## end if ( ( $i == $i_line_start...))
- } ## end if ( $type eq ':' )
+ }
+ }
if ( has_postponed_breakpoint($type_sequence) ) {
my $inc = ( $type eq ':' ) ? 0 : 1;
if ( $i >= $inc ) {
$self->set_forced_breakpoint( $i - $inc );
}
}
- } ## end if ( $is_closing_sequence_token{$token} )
+ }
# set breaks at ?/: if they will get separated (and are
# not a ?/: chain), or if the '?' is at the end of the
$self->set_forced_breakpoint($i);
}
$self->set_closing_breakpoint($i);
- } ## end if ( $i_colon <= 0 ||...)
- } ## end elsif ( $token eq '?' )
+ }
+ }
elsif ( $is_opening_token{$token} ) {
)
{
$self->set_forced_breakpoint( $i - 1 );
- } ## end if ( $block_type && ( ...))
+ }
return;
} ## end sub break_lists_increase_depth
&& !$rOpts_opening_brace_always_on_right )
{
$self->set_forced_breakpoint($i);
- } ## end if ( $token eq ')' && ...
+ }
#print "LISTY sees: i=$i type=$type tok=$token block=$block_type depth=$depth next=$next_nonblank_type next_block=$next_nonblank_block_type inter=$interrupted_list[$current_depth]\n";
$cab_flag == 4
|| $cab_flag == 0 && $last_nonblank_token eq ','
|| $cab_flag == 5 && $old_breakpoint_to_go[$i_opening];
- } ## end if ( !$is_long_term &&...)
+ }
# mark term as long if the length between opening and closing
# parens exceeds allowed line length
$is_long_term = $excess + $tol > 0;
- } ## end if ( !$is_long_term &&...)
+ }
# We've set breaks after all comma-arrows. Now we have to
# undo them if this can be a one-line block
{
$self->undo_forced_breakpoint_stack(
$breakpoint_undo_stack[$current_depth] );
- } ## end if ( ( $rOpts_comma_arrow_breakpoints...))
+ }
# now see if we have any comma breakpoints left
my $has_comma_breakpoints =
else {
$self->set_logical_breakpoints($current_depth);
}
- } ## end if ( $item_count_stack...)
+ }
if ( $is_long_term
&& @{ $rfor_semicolon_list[$current_depth] } )
# open up a long 'for' or 'foreach' container to allow
# leading term alignment unless -lp is used.
$has_comma_breakpoints = 1 unless ($lp_object);
- } ## end if ( $is_long_term && ...)
+ }
if (
{
$self->set_forced_breakpoint($i_prev);
}
- } ## end if ( $i_opening > 2 )
- } ## end if ( $minimum_depth <=...)
+ }
+ }
# break after comma following closing structure
if ( $types_to_go[ $i + 1 ] eq ',' ) {
)
{
$self->set_forced_breakpoint($i);
- } ## end if ( $is_assignment{$next_nonblank_type...})
+ }
# break at any comma before the opening structure Added
# for -lp, but seems to be good in general. It isn't
$self->set_forced_breakpoint($icomma);
}
}
- } ## end logic to open up a container
+ }
# Break open a logical container open if it was already open
elsif ($is_simple_logical_expression
# must set fake breakpoint to alert outer containers that
# they are complex
set_fake_breakpoint();
- } ## end elsif ($is_long_term)
+ }
return;
} ## end sub break_lists_decrease_depth
if ( $rOpts_variable_maximum_line_length
&& $tokens_to_go[$i_opening_paren] eq '('
&& @i_term_begin )
- ##&& !$old_breakpoint_to_go[$i_opening_paren] ) ## in b1210 patch
{
my $ib = $i_term_begin[0];
my $type = $types_to_go[$ib];
&& $item_count < 9 # doesn't have too many items
&& $opening_is_in_block # not a sub-container
&& $two_line_word_wrap_ok # ok to wrap this paren list
- ##&& $opening_token eq '(' # is paren list
)
{
# because it may occur in short blocks).
elsif (
- # we haven't already set it
- ##!$alignment_type
-
# previous token IS one of these:
(
$vert_last_nonblank_type eq ','
|| $vert_last_nonblank_type eq ';'
)
- # and its not the first token of the line
- ## && $i > $ibeg
-
# and it follows a blank
&& $types_to_go[ $i - 1 ] eq 'b'
# Undo ci of line with leading closing eval brace,
# but not beyond the indentation of the line with
# the opening brace.
- if (
- $block_type_beg eq 'eval'
- ##&& !$rOpts_line_up_parentheses
+ if ( $block_type_beg eq 'eval'
&& !ref($leading_spaces_beg)
- && !$rOpts_indent_closing_brace
- )
+ && !$rOpts_indent_closing_brace )
{
(
$opening_indentation, $opening_offset,
}
- # This flag is for testing only and should normally be zero.
- use constant TEST_DELETE_NULL => 0;
-
sub delete_unmatched_tokens {
my ( $rlines, $group_level ) = @_;
} # End loopover lines
} # End loop over subgroups
- #################################################
- # PASS 2 over subgroups to remove null alignments
- #################################################
-
- # This pass is only used for testing. It is helping to identify
- # alignment situations which might be improved with a future more
- # general algorithm which adds a tail matching capability.
- if (TEST_DELETE_NULL) {
- delete_null_alignments( $rnew_lines, $rline_hashes, \@subgroups )
- if ($saw_large_group);
- }
-
- # PASS 3: Construct a tree of matched lines and delete some small deeper
+ # PASS 2: Construct a tree of matched lines and delete some small deeper
# levels of tokens. They also block good alignments.
prune_alignment_tree($rnew_lines) if ($max_lev_diff);
- # PASS 4: compare all lines for common tokens
+ # PASS 2: compare all lines for common tokens
match_line_pairs( $rlines, $rnew_lines, \@subgroups, $group_level );
return ( $max_lev_diff, $saw_side_comment );
}
}
-sub delete_null_alignments {
- my ( $rnew_lines, $rline_hashes, $rsubgroups ) = @_;
-
- # This is an optional second pass for deleting alignment tokens which can
- # occasionally improve alignment. We look for and remove 'null
- # alignments', which are alignments that require no padding. So we can
- # 'cheat' and delete them. For example, notice the '=~' alignment in the
- # first two lines of the following code:
-
- # $sysname .= 'del' if $self->label =~ /deletion/;
- # $sysname .= 'ins' if $self->label =~ /insertion/;
- # $sysname .= uc $self->allele_ori->seq if $self->allele_ori->seq;
-
- # These '=~' tokens are already aligned because they are both the same
- # distance from the previous alignment token, the 'if'. So we can
- # eliminate them as alignments. The advantage is that in some cases, such
- # as this one, this will allow other tokens to be aligned. In this case we
- # then get the 'if' tokens to align:
-
- # $sysname .= 'del' if $self->label =~ /deletion/;
- # $sysname .= 'ins' if $self->label =~ /insertion/;
- # $sysname .= uc $self->allele_ori->seq if $self->allele_ori->seq;
-
- # The following rules for limiting this operation have been found to
- # work well and avoid problems:
-
- # Rule 1. We only consider a sequence of lines which have the same
- # sequence of alignment tokens.
-
- # Rule 2. We never eliminate the first alignment token. One reason is that
- # lines may have different leading indentation spaces, so keeping the
- # first alignment token insures that our length measurements start at
- # a well-defined point. Another reason is that nothing is gained because
- # the left-to-right sweep can always handle alignment of this token.
-
- # Rule 3. We require that the first alignment token exist in either
- # a previous line or a subsequent line. The reason is that this avoids
- # changing two-line matches which go through special logic.
-
- # Rule 4. Do not delete a token which occurs in a previous or subsequent
- # line. For example, in the above example, it was ok to eliminate the '=~'
- # token from two lines because it did not occur in a surrounding line.
- # If it did occur in a surrounding line, the result could be confusing
- # or even incorrectly aligned.
-
- # A consequence of these rules is that we only need to consider subgroups
- # with at least 3 lines and 2 alignment tokens.
-
- # The subgroup line index range
- my ( $jbeg, $jend );
-
- # Vars to keep track of the start of a current sequence of matching
- # lines.
- my $rtokens_match;
- my $rfield_lengths_match;
- my $j_match_beg;
- my $j_match_end;
- my $imax_match;
- my $rneed_pad;
-
- # Vars for a line being tested
- my $rtokens;
- my $rfield_lengths;
- my $imax;
-
- my $start_match = sub {
- my ($jj) = @_;
- $rtokens_match = $rtokens;
- $rfield_lengths_match = $rfield_lengths;
- $j_match_beg = $jj;
- $j_match_end = $jj;
- $imax_match = $imax;
- $rneed_pad = [];
- return;
- };
-
- my $add_to_match = sub {
- my ($jj) = @_;
- $j_match_end = $jj;
-
- # Keep track of any padding that would be needed for each token
- 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 {
- return unless ( $j_match_end > $j_match_beg );
- my $nlines = $j_match_end - $j_match_beg + 1;
- my $rhash_beg = $rline_hashes->[$j_match_beg];
- my $rhash_end = $rline_hashes->[$j_match_end];
- my @idel;
-
- # Do not delete unless the first token also occurs in a surrounding line
- my $tok0 = $rtokens_match->[0];
- return
- unless (
- (
- $j_match_beg > $jbeg
- && $rnew_lines->[ $j_match_beg - 1 ]->{'rtokens'}->[0] eq $tok0
- )
- || ( $j_match_end < $jend
- && $rnew_lines->[ $j_match_end + 1 ]->{'rtokens'}->[0] eq
- $tok0 )
- );
-
- # Note that we are skipping the token at i=0
- foreach my $i ( 1 .. $imax_match ) {
-
- # do not delete a token which requires padding to align
- next if ( $rneed_pad->[$i] );
-
- my $tok = $rtokens_match->[$i];
-
- # Do not delete a token which occurs in a surrounding line
- next
- if ( $j_match_beg > $jbeg
- && defined( $rline_hashes->[ $j_match_beg - 1 ]->{$tok} ) );
- next
- if ( $j_match_end < $jend
- && defined( $rline_hashes->[ $j_match_end + 1 ]->{$tok} ) );
-
- # ok to delete
- push @idel, $i;
- ##print "ok to delete tok=$tok\n";
- }
- if (@idel) {
- foreach my $j ( $j_match_beg .. $j_match_end ) {
- delete_selected_tokens( $rnew_lines->[$j], \@idel );
- }
- }
- return;
- };
-
- foreach my $item ( @{$rsubgroups} ) {
- ( $jbeg, $jend ) = @{$item};
- my $nlines = $jend - $jbeg + 1;
- next unless ( $nlines > 2 );
-
- foreach my $jj ( $jbeg .. $jend ) {
- my $line = $rnew_lines->[$jj];
- $rtokens = $line->{'rtokens'};
- $rfield_lengths = $line->{'rfield_lengths'};
- $imax = @{$rtokens} - 2;
-
- # start a new match group
- if ( $jj == $jbeg ) {
- $start_match->($jj);
- next;
- }
-
- # see if all tokens of this line match the current group
- my $match;
- if ( $imax == $imax_match ) {
- foreach my $i ( 0 .. $imax ) {
- my $tok = $rtokens->[$i];
- my $tok_match = $rtokens_match->[$i];
- last if ( $tok ne $tok_match );
- }
- $match = 1;
- }
-
- # yes, they all match
- if ($match) {
- $add_to_match->($jj);
- }
-
- # now, this line does not match
- else {
- $end_match->();
- $start_match->($jj);
- }
- } # End loopover lines
- $end_match->();
- } # End loop over subgroups
- return;
-} ## end sub delete_null_alignments
-
sub match_line_pairs {
my ( $rlines, $rnew_lines, $rsubgroups, $group_level ) = @_;
projects / perltidy.git / commitdiff