## 2023 03 09.02
+ - Issue git #121. Added parameters -xbt, or --extended-block-tightness,
+ and -xbtl=s, or --extended-block-tightness-list=s, to allow
+ certain small code blocks to have internal spacing controlled by
+ -bbt=n instead of -bt=n. The man pages have details.
+
- Issue git #118. A warning will be issued if a duplicate format-skipping
starting marker is seen within a format-skipping section. The same
applies to duplicate code-skipping starting markers within code-skipping
value <n>, the parameter <-act=n> or B<--all-containers-tightness=n> is an
abbreviation for the combination <-pt=n -sbt=n -bt=n -bbt=n>.
+=item B<-xbt>, B<--extended-block-tightness>
+
+Curly braces which are considered by perltidy to contain code blocks for
+formatting purposes exclude some of the code blocks used by Perl mainly for
+isolating terms. These include curly braces following a keyword where an
+indirect object might occur, or curly braces following a type symbol. For
+example
+
+ print {*STDERR} $message;
+ return @{$self};
+
+Since perltidy does not format these small containers as code blocks, by
+default the spacing within for these braces follows the flag
+B<--brace-tightness=n>.
+
+But they can be made to instead follow the spacing defined by the
+B<--block-brace-tightness=n> flag by seting
+B<--extended-block-tightness>.
+
+Note that if the two flags B<-bbt=n> and B<-bt=n> have the same value
+B<n> then there would be no reason to set this flag.
+
+=item B<-xbtl=s>, B<--extended-block-tightness-list=s>
+
+The small blocks to which the parameter B<-xbt> applies consist of those curly braces preceded by the keywords
+
+ print printf sort exec system say
+
+and special symbols
+
+ $ @ % & * $#
+
+To restrict B<-xbt> to apply to just the above keywords use
+
+ -xbtl=k
+
+and to restrict it to apply to just the above special type symbols use
+
+ -xbtl=t
+
+To restrict it to certain specific keywords or type symbols, enter them in the
+parameter B<s>. For example, the following restricts it apply to just the
+keywords B<print> and B<say>:
+
+ -xbtl="print say"
+
+Note that this parameter merely changes the way that the parameter
+B<--extended-block-tightness> works. It has no effect unless
+B<--extended-block-tightness> is set.
+
=item B<-tso>, B<--tight-secret-operators>
boc bok bol bom bos bot cblx ce conv cpb
cs csc cscb cscw dac dbc dbs dcbl dcsc ddf
dln dnl dop dp dpro drc dsc dsm dsn dtc
- dtt dwic dwls dwrs dws eos f fll fpva frm
- fs fso gcs hbc hbcm hbco hbh hbhh hbi hbj
- hbk hbm hbn hbp hbpd hbpu hbq hbs hbsc hbv
- hbw hent hic hicm hico hih hihh hii hij hik
- him hin hip hipd hipu hiq his hisc hiv hiw
- hsc html ibc icb icp iob isbc iscl kgb kgbd
- kgbi kis lal log lop lp lsl mem nib ohbr
- okw ola olc oll olq opr opt osbc osbr otr
- ple pod pvl q sac sbc sbl scbb schb scp
- scsb sct se sfp sfs skp sob sobb sohb sop
- sosb sot ssc st sts t tac tbc toc tp
- tqw trp ts tsc tso vbc vc vmll vsc w
- wfc wn x xci xlp xs
+ dtt dwic dwls dwrs dws eos f fpva frm fs
+ fso gcs hbc hbcm hbco hbh hbhh hbi hbj hbk
+ hbm hbn hbp hbpd hbpu hbq hbs hbsc hbv hbw
+ hent hic hicm hico hih hihh hii hij hik him
+ hin hip hipd hipu hiq his hisc hiv hiw hsc
+ html ibc icb icp iob isbc iscl kgb kgbd kgbi
+ kis lal log lop lp lsl mem nib ohbr okw
+ ola olc oll olq opr opt osbc osbr otr ple
+ pod pvl q sac sbc sbl scbb schb scp scsb
+ sct se sfp sfs skp sob sobb sohb sop sosb
+ sot ssc st sts t tac tbc toc tp tqw
+ trp ts tsc tso vbc vc viu vmll vsc w
+ wfc wn x xbt xci xlp xs
Equivalently, the prefix 'no' or 'no-' on the corresponding long names may be
used.
$add_option->( 'valign-exclusion-list', 'vxl', '=s' );
$add_option->( 'valign-inclusion-list', 'vil', '=s' );
$add_option->( 'valign-if-unless', 'viu', '!' );
+ $add_option->( 'extended-block-tightness', 'xbt', '!' );
+ $add_option->( 'extended-block-tightness-list', 'xbtl', '=s' );
########################################
$category = 4; # Comment controls
$rOpts_valign_side_comments,
$rOpts_valign_if_unless,
$rOpts_whitespace_cycle,
+ $rOpts_extended_block_tightness,
$rOpts_extended_line_up_parentheses,
# Static hashes
# INITIALIZER: sub initialize_space_after_keyword
%space_after_keyword,
+ # INITIALIZER: sub initialize_extended_block_tightness_list
+ %extended_block_tightness_list,
+
# INITIALIZED BY initialize_global_option_vars
%opening_vertical_tightness,
%closing_vertical_tightness,
initialize_space_after_keyword();
+ initialize_extended_block_tightness_list();
+
initialize_token_break_preferences();
#--------------------------------------------------------------
return;
} ## end sub initialize_space_after_keyword
+sub initialize_extended_block_tightness_list {
+
+ # keywords taking indirect objects:
+ my @k_list = keys %is_indirect_object_taker;
+
+ # type symbols which may precede an opening block brace
+ my @t_list = qw($ @ % & *);
+ push @t_list, '$#';
+
+ # Set the default to include all keywords ant types.
+ # We will build the selection in %hash
+ my %hash;
+ my @all = ( @k_list, @t_list );
+ @hash{@all} = (1) x scalar(@all);
+
+ # This can be overridden with -xbtl="..."
+ my $long_name = 'extended-block-tightness-list';
+ if ( $rOpts->{$long_name} ) {
+ my @words = split_words( $rOpts->{$long_name} );
+ my @unknown;
+
+ # Turn everything off
+ @hash{@all} = (0) x scalar(@all);
+
+ # Then turn on selections
+ foreach my $word (@words) {
+
+ # 'print' etc turns on a specific word or symbol
+ if ( defined( $hash{$word} ) ) { $hash{$word} = 1; }
+
+ # 'k' turns on all keywords
+ elsif ( $word eq 'k' ) {
+ @hash{@k_list} = (1) x scalar(@k_list);
+ }
+
+ # 't' turns on all symbols
+ elsif ( $word eq 't' ) {
+ @hash{@t_list} = (1) x scalar(@t_list);
+ }
+
+ # 'kt' same as 'k' and 't' for convenience (same as default)
+ elsif ( $word eq 'kt' ) {
+ @hash{@all} = (1) x scalar(@all);
+ }
+
+ # Anything else is an error
+ else { push @unknown, $word }
+ }
+ if (@unknown) {
+ my $num = @unknown;
+ local $LIST_SEPARATOR = SPACE;
+ Warn(<<EOM);
+$num unrecognized keyword(s) were input with --$long_name :
+@unknown
+EOM
+ }
+ }
+
+ %extended_block_tightness_list = %hash;
+ return;
+}
+
sub initialize_token_break_preferences {
# implement user break preferences
$rOpts_indent_only = $rOpts->{'indent-only'};
$rOpts_keep_interior_semicolons = $rOpts->{'keep-interior-semicolons'};
$rOpts_line_up_parentheses = $rOpts->{'line-up-parentheses'};
+ $rOpts_extended_block_tightness = $rOpts->{'extended-block-tightness'};
$rOpts_extended_line_up_parentheses =
$rOpts->{'extended-line-up-parentheses'};
$rOpts_logical_padding = $rOpts->{'logical-padding'};
my $rtokh_last_last = $rtokh_last;
+ # This will identify braces to be treated as blocks for the -xbt flag
+ my %block_type_for_tightness;
+
my ( $ws_1, $ws_2, $ws_3, $ws_4 );
# main loop over all tokens to define the whitespace flags
my $seqno = $rtokh->[_TYPE_SEQUENCE_];
my $block_type = $rblock_type_of_seqno->{$seqno};
my $last_seqno = $rtokh_last->[_TYPE_SEQUENCE_];
- my $last_block_type = $rblock_type_of_seqno->{$last_seqno};
+ my $last_block_type = $rblock_type_of_seqno->{$last_seqno}
+ || $block_type_for_tightness{$last_seqno};
$j_tight_closing_paren = -1;
# tightness = 2 means never pad inside with space
my $tightness;
- if ( $last_type eq '{'
- && $last_token eq '{'
- && $last_block_type )
- {
+ if ( $last_block_type && $last_token eq '{' ) {
$tightness = $rOpts_block_brace_tightness;
}
else { $tightness = $tightness{$last_token} }
if ( !defined($ws) ) {
my $tightness;
- my $block_type = $rblock_type_of_seqno->{$seqno};
- if ( $type eq '}' && $token eq '}' && $block_type ) {
+ my $block_type = $rblock_type_of_seqno->{$seqno}
+ || $block_type_for_tightness{$seqno};
+
+ if ( $block_type && $token eq '}' ) {
$tightness = $rOpts_block_brace_tightness;
}
else { $tightness = $tightness{$token} }
$ws = WS_NO;
}
}
+
+ # The --extended-block-tightness option allows certain braces
+ # to be treated as blocks just for setting inner whitespace
+ if ( $rOpts_extended_block_tightness && $token eq '{' ) {
+ my $seqno = $rtokh->[_TYPE_SEQUENCE_];
+ if ( !$rblock_type_of_seqno->{$seqno}
+ && $extended_block_tightness_list{$last_token} )
+ {
+
+ # Ok - make this brace a block type for tightness only
+ $block_type_for_tightness{$seqno} = $last_token;
+ }
+ }
} ## end if ( $is_opening_type{$type} ) {
# always preserve whatever space was used after a possible
--- /dev/null
+print {*STDERR} ${$data_sref};
+say {*STDERR} dump $c->{cookies};
+$rc = system {"lskdfj"} "lskdfj";
+test !eval { exec {'notaint'} $TAINT }, 'exec';
+delete ${"$ {dest}::"}{$name};
+my @matches = @{$nodes_ref} > 1 ? @{$nodes_ref}[ 1 .. $#{$nodes_ref} ] : ();
+%{$self} = %{$project};
+*{$name} = $sub;
+grep { defined &{ ${"${class}::"}{$_} } } &{"${class}::Clear"}();
--- /dev/null
+print { *STDERR } ${ $data_sref };
+say { *STDERR } dump $c->{cookies};
+$rc = system { "lskdfj" } "lskdfj";
+test !eval { exec { 'notaint' } $TAINT }, 'exec';
+delete ${ "$ {dest}::" }{$name};
+my @matches =
+ @{ $nodes_ref } > 1 ? @{ $nodes_ref }[ 1 .. $#{ $nodes_ref } ] : ();
+%{ $self } = %{ $project };
+*{ $name } = $sub;
+grep { defined &{ ${ "${class}::" }{$_} } } &{ "${class}::Clear" }();
--- /dev/null
+print { *STDERR } ${$data_sref};
+say { *STDERR } dump $c->{cookies};
+$rc = system { "lskdfj" } "lskdfj";
+test !eval { exec { 'notaint' } $TAINT }, 'exec';
+delete ${"$ {dest}::"}{$name};
+my @matches = @{$nodes_ref} > 1 ? @{$nodes_ref}[ 1 .. $#{$nodes_ref} ] : ();
+%{$self} = %{$project};
+*{$name} = $sub;
+grep { defined &{ ${"${class}::"}{$_} } } &{"${class}::Clear"}();
--- /dev/null
+print {*STDERR} ${$data_sref};
+say {*STDERR} dump $c->{cookies};
+$rc = system {"lskdfj"} "lskdfj";
+test !eval {exec {'notaint'} $TAINT}, 'exec';
+delete ${"$ {dest}::"}{$name};
+my @matches = @{$nodes_ref} > 1 ? @{$nodes_ref}[ 1 .. $#{$nodes_ref} ] : ();
+%{$self} = %{$project};
+*{$name} = $sub;
+grep {defined &{${"${class}::"}{$_}}} &{"${class}::Clear"}();
../snippets28.t recombine8.def
../snippets28.t git116.def
../snippets28.t git116.git116
+../snippets28.t xbt.def
+../snippets28.t xbt.xbt1
+../snippets28.t xbt.xbt2
+../snippets28.t xbt.xbt3
../snippets3.t ce_wn1.ce_wn
../snippets3.t ce_wn1.def
../snippets3.t colin.colin
--- /dev/null
+print {*STDERR} ${$data_sref};
+say {*STDERR} dump $c->{cookies};
+$rc = system {"lskdfj"} "lskdfj";
+test !eval { exec { 'notaint' } $TAINT }, 'exec';
+delete ${"$ {dest}::"}{$name};
+my @matches = @{$nodes_ref} > 1 ? @{$nodes_ref}[ 1 .. $#{$nodes_ref} ] : ();
+%{$self} = %{$project};
+*{$name} = $sub;
+grep { defined &{ ${ "${class}::" }{$_} } }
+&{"${class}::Clear"}();
--- /dev/null
+-xbt -xbtl=k
--- /dev/null
+-xbt -bbt=2 -xbtl="print say t"
#5 recombine8.def
#6 git116.def
#7 git116.git116
+#8 xbt.def
+#9 xbt.xbt1
+#10 xbt.xbt2
+#11 xbt.xbt3
# To locate test #13 you can search for its name or the string '#13'
'git116' => "-viu",
'olbxl2' => <<'----------',
-olbxl='*'
+----------
+ 'xbt1' => "-xbt",
+ 'xbt2' => "-xbt -xbtl=k",
+ 'xbt3' => <<'----------',
+-xbt -bbt=2 -xbtl="print say t"
----------
};
'recombine8' => <<'----------',
# recombine uses normal forward mode
$v_gb = -1*(eval($pmt_gb))*(-1+((((-1+(1/((eval($i_gb)/100)+1))** ((eval($n_gb)-1)))))/(eval($i_gb)/100)));
+----------
+
+ 'xbt' => <<'----------',
+print {*STDERR} ${$data_sref};
+say {*STDERR} dump $c->{cookies};
+$rc = system {"lskdfj"} "lskdfj";
+test !eval { exec { 'notaint' } $TAINT }, 'exec';
+delete ${"$ {dest}::"}{$name};
+my @matches = @{$nodes_ref} > 1 ? @{$nodes_ref}[ 1 .. $#{$nodes_ref} ] : ();
+%{$self} = %{$project};
+*{$name} = $sub;
+grep { defined &{ ${ "${class}::" }{$_} } }
+&{"${class}::Clear"}();
----------
};
print join( "\n", @RPMOutput ) . "\n" unless $Quiet;
#7...........
},
+
+ 'xbt.def' => {
+ source => "xbt",
+ params => "def",
+ expect => <<'#8...........',
+print {*STDERR} ${$data_sref};
+say {*STDERR} dump $c->{cookies};
+$rc = system {"lskdfj"} "lskdfj";
+test !eval { exec {'notaint'} $TAINT }, 'exec';
+delete ${"$ {dest}::"}{$name};
+my @matches = @{$nodes_ref} > 1 ? @{$nodes_ref}[ 1 .. $#{$nodes_ref} ] : ();
+%{$self} = %{$project};
+*{$name} = $sub;
+grep { defined &{ ${"${class}::"}{$_} } } &{"${class}::Clear"}();
+#8...........
+ },
+
+ 'xbt.xbt1' => {
+ source => "xbt",
+ params => "xbt1",
+ expect => <<'#9...........',
+print { *STDERR } ${ $data_sref };
+say { *STDERR } dump $c->{cookies};
+$rc = system { "lskdfj" } "lskdfj";
+test !eval { exec { 'notaint' } $TAINT }, 'exec';
+delete ${ "$ {dest}::" }{$name};
+my @matches =
+ @{ $nodes_ref } > 1 ? @{ $nodes_ref }[ 1 .. $#{ $nodes_ref } ] : ();
+%{ $self } = %{ $project };
+*{ $name } = $sub;
+grep { defined &{ ${ "${class}::" }{$_} } } &{ "${class}::Clear" }();
+#9...........
+ },
+
+ 'xbt.xbt2' => {
+ source => "xbt",
+ params => "xbt2",
+ expect => <<'#10...........',
+print { *STDERR } ${$data_sref};
+say { *STDERR } dump $c->{cookies};
+$rc = system { "lskdfj" } "lskdfj";
+test !eval { exec { 'notaint' } $TAINT }, 'exec';
+delete ${"$ {dest}::"}{$name};
+my @matches = @{$nodes_ref} > 1 ? @{$nodes_ref}[ 1 .. $#{$nodes_ref} ] : ();
+%{$self} = %{$project};
+*{$name} = $sub;
+grep { defined &{ ${"${class}::"}{$_} } } &{"${class}::Clear"}();
+#10...........
+ },
+
+ 'xbt.xbt3' => {
+ source => "xbt",
+ params => "xbt3",
+ expect => <<'#11...........',
+print {*STDERR} ${$data_sref};
+say {*STDERR} dump $c->{cookies};
+$rc = system {"lskdfj"} "lskdfj";
+test !eval {exec {'notaint'} $TAINT}, 'exec';
+delete ${"$ {dest}::"}{$name};
+my @matches = @{$nodes_ref} > 1 ? @{$nodes_ref}[ 1 .. $#{$nodes_ref} ] : ();
+%{$self} = %{$project};
+*{$name} = $sub;
+grep {defined &{${"${class}::"}{$_}}} &{"${class}::Clear"}();
+#11...........
+ },
};
my $ntests = 0 + keys %{$rtests};