]> git.donarmstrong.com Git - perltidy.git/commitdiff
add parameters -xbt, -xbtl; see issue git #121
authorSteve Hancock <perltidy@users.sourceforge.net>
Sat, 10 Jun 2023 02:55:08 +0000 (19:55 -0700)
committerSteve Hancock <perltidy@users.sourceforge.net>
Sat, 10 Jun 2023 02:55:08 +0000 (19:55 -0700)
14 files changed:
CHANGES.md
bin/perltidy
lib/Perl/Tidy.pm
lib/Perl/Tidy/Formatter.pm
t/snippets/expect/xbt.def [new file with mode: 0644]
t/snippets/expect/xbt.xbt1 [new file with mode: 0644]
t/snippets/expect/xbt.xbt2 [new file with mode: 0644]
t/snippets/expect/xbt.xbt3 [new file with mode: 0644]
t/snippets/packing_list.txt
t/snippets/xbt.in [new file with mode: 0644]
t/snippets/xbt1.par [new file with mode: 0644]
t/snippets/xbt2.par [new file with mode: 0644]
t/snippets/xbt3.par [new file with mode: 0644]
t/snippets28.t

index 42c536c9d2820a4d64059b1f6f91ee19a7f3dc4c..a60341612326210bba009a7116641941725a90d0 100644 (file)
@@ -2,6 +2,11 @@
 
 ## 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
index 6e52e85552838fcde58b2587c4fb44ca1365d367..e643b705223b2f5a2bf48ef98e2ea86eb9a203a4 100755 (executable)
@@ -1239,6 +1239,56 @@ To simplify input in the case that all of the tightness flags have the same
 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>
 
@@ -5555,19 +5605,19 @@ The following list shows all short parameter names which allow a prefix
  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.
index aac92705f3ea25511885d10f0f7d2eef11f4d7dd..375eae54ed29edd98e8583c049081c587df2d007 100644 (file)
@@ -3237,6 +3237,8 @@ sub generate_options {
     $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
index 57967cb3e5eb709a2efcd3647d5a194f14a4d717..9d813ad4ff6a655fcd1e50b1807c5c4dcc663abe 100644 (file)
@@ -235,6 +235,7 @@ my (
     $rOpts_valign_side_comments,
     $rOpts_valign_if_unless,
     $rOpts_whitespace_cycle,
+    $rOpts_extended_block_tightness,
     $rOpts_extended_line_up_parentheses,
 
     # Static hashes
@@ -315,6 +316,9 @@ my (
     # 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,
@@ -1561,6 +1565,8 @@ EOM
 
     initialize_space_after_keyword();
 
+    initialize_extended_block_tightness_list();
+
     initialize_token_break_preferences();
 
     #--------------------------------------------------------------
@@ -2151,6 +2157,68 @@ sub initialize_space_after_keyword {
     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
@@ -2372,6 +2440,7 @@ sub initialize_global_option_vars {
     $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'};
@@ -2896,6 +2965,9 @@ sub set_whitespace_flags {
 
     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
@@ -2929,7 +3001,8 @@ sub set_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;
 
@@ -2951,10 +3024,7 @@ sub set_whitespace_flags {
                 # 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} }
@@ -3121,8 +3191,10 @@ sub set_whitespace_flags {
                 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} }
@@ -3266,6 +3338,19 @@ sub set_whitespace_flags {
                     $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
diff --git a/t/snippets/expect/xbt.def b/t/snippets/expect/xbt.def
new file mode 100644 (file)
index 0000000..8175e26
--- /dev/null
@@ -0,0 +1,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"}();
diff --git a/t/snippets/expect/xbt.xbt1 b/t/snippets/expect/xbt.xbt1
new file mode 100644 (file)
index 0000000..1232e9f
--- /dev/null
@@ -0,0 +1,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" }();
diff --git a/t/snippets/expect/xbt.xbt2 b/t/snippets/expect/xbt.xbt2
new file mode 100644 (file)
index 0000000..c2b711e
--- /dev/null
@@ -0,0 +1,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"}();
diff --git a/t/snippets/expect/xbt.xbt3 b/t/snippets/expect/xbt.xbt3
new file mode 100644 (file)
index 0000000..a5b657e
--- /dev/null
@@ -0,0 +1,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"}();
index 221d442dc7ffb50bd87557ef659fea4b427cbd45..2b096e36826713c548b826a3659eb076f6553ddf 100644 (file)
 ../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
diff --git a/t/snippets/xbt.in b/t/snippets/xbt.in
new file mode 100644 (file)
index 0000000..1aa78d3
--- /dev/null
@@ -0,0 +1,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"}();
diff --git a/t/snippets/xbt1.par b/t/snippets/xbt1.par
new file mode 100644 (file)
index 0000000..73611f1
--- /dev/null
@@ -0,0 +1 @@
+-xbt
diff --git a/t/snippets/xbt2.par b/t/snippets/xbt2.par
new file mode 100644 (file)
index 0000000..2a4dc0e
--- /dev/null
@@ -0,0 +1 @@
+-xbt -xbtl=k
diff --git a/t/snippets/xbt3.par b/t/snippets/xbt3.par
new file mode 100644 (file)
index 0000000..fdcce46
--- /dev/null
@@ -0,0 +1 @@
+-xbt -bbt=2 -xbtl="print say t"
index e0a3712d81559fd3d2fdf19133bf26362d9694d9..f0c547bd91592314d6bc1487cfc745dbd7ff35b6 100644 (file)
@@ -8,6 +8,10 @@
 #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'
 
@@ -29,6 +33,11 @@ BEGIN {
         'git116' => "-viu",
         'olbxl2' => <<'----------',
 -olbxl='*'
+----------
+        'xbt1' => "-xbt",
+        'xbt2' => "-xbt -xbtl=k",
+        'xbt3' => <<'----------',
+-xbt -bbt=2 -xbtl="print say t"
 ----------
     };
 
@@ -93,6 +102,19 @@ $rotate = Math::MatrixReal->new_from_string( "[ " . cos($theta) . " " . -sin($th
         '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"}();
 ----------
     };
 
@@ -215,6 +237,71 @@ print "RPM Output:\n"                 unless $Quiet;
 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};