diff options
author | Norbert Preining <norbert@preining.info> | 2020-10-12 03:04:00 +0000 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2020-10-12 03:04:00 +0000 |
commit | 0ce40abb18ec02ec6fd6bcc5f21612c88daa7578 (patch) | |
tree | 416289fe1448873fd8ca33051f50ad85bffa8aaa /support/splint/scripts | |
parent | fdb18507cd80dc17f5a5256153d34668b4f4e61c (diff) |
CTAN sync 202010120303
Diffstat (limited to 'support/splint/scripts')
-rwxr-xr-x | support/splint/scripts/bindx.pl | 216 | ||||
-rwxr-xr-x | support/splint/scripts/brack.pl | 145 | ||||
-rwxr-xr-x | support/splint/scripts/cslist.pl | 77 | ||||
-rwxr-xr-x | support/splint/scripts/misccw.pl | 94 | ||||
-rwxr-xr-x | support/splint/scripts/unline.pl | 69 |
5 files changed, 550 insertions, 51 deletions
diff --git a/support/splint/scripts/bindx.pl b/support/splint/scripts/bindx.pl index ace62429ba..beb9719bf8 100755 --- a/support/splint/scripts/bindx.pl +++ b/support/splint/scripts/bindx.pl @@ -1,8 +1,60 @@ #!/usr/bin/perl +# Copyright 2012-2020, Alexander Shibakov +# This file is part of SPLinT +# +# SPLinT is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# SPLinT is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with SPLinT. If not, see <http://www.gnu.org/licenses/>. + +use Getopt::Long; +use Pod::Usage; +use File::Basename; +use English; + +( $my_name, $my_path, $my_suffix ) = fileparse( $PROGRAM_NAME ); +$invocation_line = "\% ".$my_name." ".(join ' ', @ARGV)."\n"; + +my $man = 0; +my $help = 0; +my $fine_index = 0; +my $fine_headercs = "\\FI"; # index command sequence for the fine format +my $crude_headercs = "\\GI"; # index command sequence for the standard format +my $headercs = ""; # the default is the standard format + +#Getopt::Long::Configure ("bundling"); # to allow -abc to set a, b, and c + +GetOptions ("help|?" => \$help, + man => \$man, + "fine" => \$fine_index, + "cs=s" => \$headercs + ) or pod2usage(2); + +pod2usage(-exitval => 0, -verbose => 1) if $help; +pod2usage(-exitval => 0, -verbose => 2) if $man; + open FILE, "$ARGV[0]" or die "Cannot open input file $ARGV[0]\n"; open FILE_OUT, ">$ARGV[1]" or die "Cannot open input file $ARGV[1]\n"; +if ( $headercs eq "" ) { + if ( $fine_index ) { + $headercs = $fine_headercs; + } else { + $headercs = $crude_headercs; + } +} + +print FILE_OUT $invocation_line; + sub lex_order (\@\@) { # lexicographic ordering my (@string1) = @{shift @_}; @@ -43,39 +95,82 @@ sub lexicographically { # lexicographic ordering for numeric sequences separated return lex_order @chars1, @chars2; } -$alphabet = "\#\$\%^&*<>[]{}()+-=_|\\,:;~`.?!\'\"\@0123456789AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz"; +$alphabet = " /\#\$\%^&*<>[]{}()+-=_|\\,:;~`.?!\'\"\@0123456789AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz"; @main_set = split //, $alphabet; map { $main_order{$_} = index $alphabet, $_ } @main_set; # inefficient ... -$ldelim[1] = "\\["; $rdelim[1] = "]"; $ldelim[0] = "\\("; $rdelim[0] = ")"; -$ldelim[5] = "\\e"; $rdelim[5] = "e"; -$ldelim[4] = "\\f"; $rdelim[4] = "f"; +$ldelim[1] = "\\["; $rdelim[1] = "]"; +$ldelim[2] = ""; $rdelim[2] = ""; $ldelim[3] = "\\g"; $rdelim[3] = "g"; +$ldelim[4] = "\\f"; $rdelim[4] = "f"; +$ldelim[5] = "\\e"; $rdelim[5] = "e"; + +sub alpha_jump { # have we switched to the next letter? + + my $a = substr shift @_, 0, 1; + my $b = substr shift @_, 0, 1; + + $a =~ tr/a-z/A-Z/; $a =~ tr/a-zA-Z/0/cs; + + return (ord $a) <=> (ord $b); +} while (<FILE>) { $input = $_; - if ( $input =~ /\\(.)TI\s*([0-9]+)\s*\{(\\[a-z]+)\s*\{(.+)\}\}\{(.+)\}\{(.+)\}\{(.+)\}\n/ ) { - - ($domain, $rank, $type, $key, $nspace, $pageno, $ref) = ($1, $2, $3, $4, $5, $6, $7); + if ( $input =~ /\\i\@\@\@e\s* \{([0-9]+)\} # section number + \{([0-9]+)\} # page number + \{((\{[^\{\}]*\})+)\} # host namespace, context, etc. + \{([^\{\}]+)\} # domain + \{([0-9]+)\} # rank + \{([^\{\}]*)\} # type1 + \{([^\{\}\s]+)\s*\} # type2 + \{((\{[^\{\}]+\})+)\} # key + \{((\{[^\{\}]+\})*)\} # visual key + (\%.*)*\n/x ) { + # ordinary index entry + + ($section, $pageno, $nspace, $junk0, $domain, $rank, $type1, $type2, $key, $junk1, $vkey) = + ($1, $2, $3, $4, $5, $6, $7, $8, $9, $10, $11 ); + $key =~ s/\{([0-9]+)\}/pack "c1", $1/eg; - - push @{$index{$domain}{$key}{refs}}, "$ref $rank"; - $index{$domain}{$key}{nspace} = $nspace; - $index{$domain}{$key}{type} = $type; + $term = $key; + $vkey =~ s/\{([0-9]+)\}/pack "c1", $1/eg; + + if ( $vkey ne "" ) { + + if (exists $index{$domain}{$vkey}{type} && $index{$domain}{$vkey}{type} ne $type2) { + #warn "Differing output types for term <$term> with key <$vkey>.\n", "$index{$domain}{$vkey}{type} vs. $type2\n"; + $key = "$vkey $key"; + + if (exists $index{$domain}{$key}{type} && $index{$domain}{$key}{type} ne $type2) { + warn "Differing output types for term <$term> with key <$vkey>.\n", "$index{$domain}{$vkey}{type} vs. $type2\n"; + } + } else { + $key = $vkey; + } + } + + # print "KEY: ", $key, " ", $vkey, "\n"; + + push @{$index{$domain}{$key}{refs}}, "$section $rank $pageno"; + $index{$domain}{$key}{nspace} = $nspace; + $index{$domain}{$key}{type} = $type2; + $index{$domain}{$key}{term} = $term; } - } $i = 0; +$last_alpha = "0"; # the last index section foreach $domain (sort keys %index ) { if ( $i > 0) { + $last_alpha = "0"; print FILE_OUT "\\indexseparator{$domain}{$i}\n"; } @@ -84,18 +179,95 @@ foreach $domain (sort keys %index ) { foreach $key ( sort alphabetically keys %{$index{$domain}} ) { - %ref_list = (); - map { exists $ref_list{$_} ? ($ref_list{$_}++) : ($ref_list{$_} = 0) } @{$index{$domain}{$key}{refs}}; + if (exists $index{$domain}{$key}{refs}) { + + %ref_hash = (); + map { @r = split / /, $_; exists $ref_hash{$r[0]}{$r[1]}{$r[2]} ? + $ref_hash{$r[0]}{$r[1]}{$r[2]}++ : ($ref_hash{$r[0]}{$r[1]}{$r[2]} = 0) } @{$index{$domain}{$key}{refs}}; + + my @fine_ref_list = (); + my @crude_ref_list = (); + + foreach $key ( reverse sort numerically keys %ref_hash ) { + + foreach $rkey ( reverse sort numerically keys %{$ref_hash{$key}} ) { + + $ref_string = "$ldelim[$rkey]$key$rdelim[$rkey]"; + push @crude_ref_list, $ref_string; + $ref_string = $ref_string."\{".(join ', ', (reverse sort numerically keys %{$ref_hash{$key}{$rkey}}))."\}"; + push @fine_ref_list, $ref_string; - @ref_list = sort lexicographically keys %ref_list; - @ref_list = map { @r = split / /, $_; "$ldelim[$r[1]]$r[0]$rdelim[$r[1]]" } @ref_list; + } - $ukey = $key; - $ukey =~ s/(.)/"\{".(unpack "c1", $1)."\}"/eg; - - print FILE_OUT "\\GI{$index{$domain}{$key}{nspace}}{$index{$domain}{$key}{type}}{$ukey}, ", - (join ', ', @ref_list), ". \% $key, sec nos. ", (join ', ', @ref_list ), "\n"; - + } + + $ref_string = join ', ', @fine_ref_list; + $cref_string = join ', ', @crude_ref_list; + + $term = $index{$domain}{$key}{term}; + $term_printable = $term; + $term =~ s/(.)/"\{".(unpack "c1", $1)."\}"/eg; + + if ( alpha_jump( $key, $last_alpha ) > 0 ) { + $last_alpha = substr $key, 0, 1; + $last_alpha =~ tr/a-z/A-Z/; + print FILE_OUT "\\indexsection{$last_alpha}\n", + } + + print FILE_OUT $headercs."{$index{$domain}{$key}{nspace}}{$index{$domain}{$key}{type}}{$term}, ". + ($fine_index ? $ref_string : $cref_string).".\% $term_printable, ($key)\n", + "\% sec nos. ".$ref_string."\n"; + + } } } +__END__ + +=head1 BINDX + +bindx.pl - Postprocess an index (.gdx) in <input_file> to produce a set of index entries in + the <output_file> (.gdy) + +=head1 SYNOPSIS + +bindx.pl [options] input_file output_file + + + Options: + --help|-h|-? brief help message + --man|-m full documentation + --fine|-f add page references to each index entry + --cs=<string> specify the index control sequence name + +=head1 OPTIONS + +=over 8 + +=item B<--help> + +Print a brief help message and exit. + +=item B<--man> + +Print the manual page and exit. + +=item B<--fine> + +Create index entries in the form B<r>I<nnn>B<l>{n1, n2, ...} where B<r> and B<l> +are the left and ring delimeters, I<nnn> is the section number and the list of page +numbers appears inside the braced group. + +=item B<--cs> + +The name of the index control sequence. The default is B<\GI> for the standard +index format and B<\FI> for the 'fine' format. + +=back + +=head1 DESCRIPTION + +B<bindx.pl> will read the given <input_file>, and output an index +in the <output_file>. + +=cut diff --git a/support/splint/scripts/brack.pl b/support/splint/scripts/brack.pl index 6e110e5cf3..887c6324f0 100755 --- a/support/splint/scripts/brack.pl +++ b/support/splint/scripts/brack.pl @@ -1,15 +1,51 @@ #!/usr/bin/perl +# Copyright 2012-2020, Alexander Shibakov +# This file is part of SPLinT +# +# SPLinT is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# SPLinT is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with SPLinT. If not, see <http://www.gnu.org/licenses/>. + # a simple script to replace all @G ... @`other' regions with # @= ... @>@; lines # comments are allowed at the end of the lines. # only one style of comments is accepted: /* ... */. note that these are not # output +use Getopt::Long; +use Pod::Usage; + +my $man = 0; +my $help = 0; +my $elang_start = "\@t}\\lsectionbegin{\%s}\\vb{\@>\n"; +my $elang_finish = "\@t}\\vb{\\yyendgame}\\vb{}\\endparse\\postparse{\@>\n"; + +#Getopt::Long::Configure ("bundling"); # to allow -abc to set a, b, and c + +GetOptions ("help|?" => \$help, + man => \$man, + "startol=s" => \$elang_start, # the string that starts an `other language' region + "finishol=s" => \$elang_finish # the string that ends an `other language' region + ) or pod2usage(2); + +pod2usage(-exitval => 0, -verbose => 1) if $help; +pod2usage(-exitval => 0, -verbose => 2) if $man; + open FILE, "$ARGV[0]" or die "Cannot open input file $ARGV[0]\n"; open FILEOUT, ">$ARGV[1]" or die "Cannot open output file $ARGV[1]\n"; $state = 0; +$paused_state = 0; while (<FILE>) { $inline = $_; @@ -17,20 +53,22 @@ while (<FILE>) { if ( $inline =~ m/^\@G(.*)$/ ) { # @G detected, this line is part of the `other language' region - $inline = $1; $state = 1; - if ( $inline =~ m/^\(([^)]*)\).*/ ) { - printf FILEOUT "\@q Start generic language section\@>\n\@t}\\begingsec{%s}{\@>\n", "$1"; # a parser switcher - } else { - $inline = " Start \@\@G (generic) language section"; - printf FILEOUT "\@q%s\@>\n\@t}\\begingsec{b}{\@>\n", "$inline"; # a parser switcher - } + $inline = $1; $state = 1; + + if ( $inline =~ m/^\(([^)]*)\).*/ ) { # language specifier present + $inline = $1; + } else { + $inline = "b"; + } + + printf FILEOUT "\@q Start generic language section\@>\n" . $elang_start, "$inline"; # a parser switcher - } elsif ( $inline =~ m/^\@[\scp].*$/ ) { # @`other' detected, so `other language' region is over + } elsif ( $inline =~ m/^\@[\scp\*0-9].*$/ ) { # @`other' detected, so `other language' region is over if ($state == 1) { - printf FILEOUT "\@q%s\@>\n\@t}\\endgsec{\@>\n", - "End of generic language section"; # a parser switcher - } + printf FILEOUT "\@q%s\@>\n" . $elang_finish, "End of generic language section"; # a parser switcher + } + $state = 0; printf FILEOUT "%s", "$inline"; @@ -38,35 +76,33 @@ while (<FILE>) { printf FILEOUT "%s", "$inline"; - } elsif ( $inline =~ m/^\@g(.*)$/ ) { # @`other' detected, so `other language' region is over + } elsif ( $inline =~ m/^\@g(.*)$/ ) { # explicit end of other languge region detected - if ($state == 1) { - printf FILEOUT "\@q%s\@>\n\@t}\\endgsec{\@>\n", - "End of generic language section"; # a parser switcher - } + $inline = $1; - $inline = $1; $state = 0; + if ($state == 1) { + printf FILEOUT "\@q%s\@>\n" . $elang_finish, "End of generic language section"; # a parser switcher + } - if ( not $inline ) { $inline = "End generic language section"; } - printf FILEOUT "\@q%s\@>\n", "$inline"; + $state = 0; } elsif ( $inline =~ m/^\@O(.*)$/ ) { # @O detected, so `other language' region is paused - $inline = $1; $state = 0; + $inline = $1; $paused_state = $state; $state = 0; if ( not $inline ) { $inline = "End generic language section"; } printf FILEOUT "\@q%s\@>\n", "$inline"; } elsif ( $inline =~ m/^\@o(.*)$/ ) { # @o detected, so `other language' region is resumed - $inline = $1; $state = 1; + $inline = $1; $state = $paused_state; $paused_state = 0; if ( not $inline ) { $inline = "End generic language section"; } printf FILEOUT "\@q%s\@>\n", "$inline"; - } elsif ( $state == 1 ) { + } elsif ( $state != 0 ) { - if ( $inline =~ m/\/\*.*\*\/\s*$/ ) { + if ( $inline =~ m/\/\*.*\*\/\s*$/ ) { # the line contains a comment at the end $inline =~ m/^(.*\S|)\s*(\/\*.*\*\/)\s*$/; $string = $1; $comment = $2; @@ -80,11 +116,11 @@ while (<FILE>) { if ( $string ) { - printf FILEOUT "\@=%s\@>\@;", "$string"; + printf FILEOUT "\@=%s\@>\@t}\\vb{\\n}{\@>\@;", "$string"; } else { - printf FILEOUT "\@=%s\@>\@;", " "; + printf FILEOUT "\@=%s\@>\@t}\\vb{\\n}{\@>\@;", " "; # to keep \CWEB\ happy } @@ -103,3 +139,62 @@ while (<FILE>) { } } + +__END__ + +=head1 BRACK + +brack.pl - Preprocess a CWEB file to allow language extensions + +=head1 SYNOPSIS + +brack.pl [options] input_file output_file + + + Options: + --help|-h|-? brief help message + --man|-m full documentation + --startol|-s string to begin a language region + --finishol|-f string to end a language region + +=head1 OPTIONS + +=over 8 + +=item B<--help> + +Print a brief help message and exit. + +=item B<--man> + +Print the manual page and exit. + +=item B<--startol>=I<CWEB string> + +The string to print at the beginning of an other language region + +=item B<--finishol>=I<CWEB string> + +The string to print at the end of an other language region + +=back + +=head1 DESCRIPTION + +B<brack.pl> will read the given <input_file>, and the format @G(...) sections +appropriately to be read by CWEAVE and output the result in the <output_file>. + +The processing mechanism is very primitive and makes use of some assumptions +on the appearance of the B<CWEB> file. Unlike the 'standard' B<CWEB> input, the +new 'generic language' section markers (the @G(...) construct) are +I<case sensitive> and I<must> appear at the beginning of the line. The +'other language' markers (the @O... sections) follow the same restrictions as +the @G sections above, and I<do not nest>. + +A comment at the very end of the line is moved to the B<C> portion of the input. +To put the comment inside the verbatim blocks, one may surround it by [@>@=] and +[@>@= ] (the square brackets are not part of the input and are here to draw attention +to the spacing, see next). Note the space at the end of the closing construct: this +is necessary to pacify B<CWEAVE>. + +=cut diff --git a/support/splint/scripts/cslist.pl b/support/splint/scripts/cslist.pl index d1df62bc07..9c187517ac 100755 --- a/support/splint/scripts/cslist.pl +++ b/support/splint/scripts/cslist.pl @@ -1,3 +1,36 @@ +#!/usr/bin/perl + +# Copyright 2012-2020, Alexander Shibakov +# This file is part of SPLinT +# +# SPLinT is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# SPLinT is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with SPLinT. If not, see <http://www.gnu.org/licenses/>. + +use Getopt::Long; +use Pod::Usage; + +my $man = 0; +my $help = 0; + +#Getopt::Long::Configure ("bundling"); # to allow -abc to set a, b, and c + +GetOptions ("help|?" => \$help, + man => \$man, + ) or pod2usage(2); + +pod2usage(-exitval => 0, -verbose => 1) if $help; +pod2usage(-exitval => 0, -verbose => 2) if $man; + for ($i = 0; $i <= $#ARGV; $i++) { open FILE, "<$ARGV[$i]" or die "Cannot open file $ARGV[$i]!\n"; @@ -7,7 +40,7 @@ for ($i = 0; $i <= $#ARGV; $i++) { $text = $_; - while( $text =~ /(\\newcount|\\newtoks|\\newdimen|\\newif|\\let|\\([exg]|char|toks|count)*def)\w*(\\[a-zA-Z@]+)/g ) { + while( $text =~ /(\\newcount|\\newtoks|\\newdimen|\\newif|\\let|\\([exg]|char|toks|count)?def)\w*(\\[a-zA-Z@]+)/g ) { $cs = $3; push @all, $cs; @@ -24,8 +57,8 @@ for ($i = 0; $i <= $#ARGV; $i++) { foreach $ocs (@alphsecs) { - print "$ocs %"; - @fnames = sort keys $secse{$ocs}; + print "$ocs \% ". ref $secse{$osc}; + @fnames = sort keys %{$secse{$ocs}}; foreach $fname (@fnames) { print " $fname ($secse{$ocs}->{$fname} occurence"; if ( $secse{$ocs}->{$fname} > 1 ) {print "s";} @@ -38,3 +71,41 @@ print "\n"; $i = $#alphsecs; $i++; print "total sequences: $i\n"; + +__END__ + +=head1 CSLIST + +cslist.pl - output a list of all control sequences in the input files. + +=head1 SYNOPSIS + +cslist.pl [options] input_files + + + Options: + --help|-h|-? brief help message + --man|-m full documentation + +=head1 OPTIONS + +=over 8 + +=item B<--help> + +Print a brief help message and exit. + +=item B<--man> + +Print the manual page and exit. + +=back + +=head1 DESCRIPTION + +B<cslist.pl> will read the given <input_files>, and produce a list of all the +B<TeX> control sequences defined in those files (a contorl sequence is considered +I<defined> in a file B<foo.tex> if one of B<\def>, B<\let>, B<\new...>, or similar +preceeds it in B<foo.tex>. + +=cut diff --git a/support/splint/scripts/misccw.pl b/support/splint/scripts/misccw.pl new file mode 100755 index 0000000000..b536904df4 --- /dev/null +++ b/support/splint/scripts/misccw.pl @@ -0,0 +1,94 @@ +#!/usr/bin/perl + +# Copyright 2012-2020, Alexander Shibakov +# This file is part of SPLinT +# +# SPLinT is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# SPLinT is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with SPLinT. If not, see <http://www.gnu.org/licenses/>. + +use Getopt::Long; +use Pod::Usage; + +my $man = 0; +my $help = 0; +my $alpha_list = 0; +my $alpha_length = 1; + +#Getopt::Long::Configure ("bundling"); # to allow -abc to set a, b, and c + +GetOptions ("help|?" => \$help, + man => \$man, + "alpha-list" => \$alpha_list, + "alpha-length=i" => \$alpha_length + ) or pod2usage(2); + +pod2usage(-exitval => 0, -verbose => 1) if $help; +pod2usage(-exitval => 0, -verbose => 2) if $man; + +if ( $alpha_list ) { + open FILE_OUT, ">$ARGV[0]" or die "Cannot open input file $ARGV[0]\n"; + + $alphabet = "abcdefghijklomnopqrstuvwxyz"; + + @alpha_chars = split //, $alphabet; + + foreach $letter ( @alpha_chars ) { + $letter_array[0] = $letter; + for ( $i = 1; $i < $alpha_length; $i++ ) { + $letter_array[$i] = '!'; + } + $string = join '', @letter_array; + print FILE_OUT "\@!\@:".$string."\@>\n"; + } +} + +__END__ + +=head1 MISCCW + +misccw.pl - Miscellaneous functions + +=head1 SYNOPSIS + +misccw.pl [options] [input_file] [output_file] + + + Options: + --help|-h|-? brief help message + --man|-m full documentation + --alpha-list generate a list of alphabetic markers + +=head1 OPTIONS + +=over 8 + +=item B<--help> + +Print a brief help message and exit. + +=item B<--man> + +Print the manual page and exit. + +=item B<--alpha-list> + +Output a list of markers of the form @:?????@> in <output_file> + +=back + +=head1 DESCRIPTION + +B<misccw.pl> will possibly read the given <input_file>, and likely output +something in the <output_file> depending on the options given. + +=cut diff --git a/support/splint/scripts/unline.pl b/support/splint/scripts/unline.pl index 5349156cb4..36a1b524f5 100755 --- a/support/splint/scripts/unline.pl +++ b/support/splint/scripts/unline.pl @@ -1,10 +1,41 @@ #!/usr/bin/perl +# Copyright 2012-2020, Alexander Shibakov +# This file is part of SPLinT +# +# SPLinT is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# SPLinT is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with SPLinT. If not, see <http://www.gnu.org/licenses/>. + # a simple script to remove comments and #line directives left by CTANGLE # this allows one to build Makefiles and linker scripts from inside CWEB # by making a few simple changes to the macros (to facilitate typeseting) # and using CWEB's @= ... @> facility. +use Getopt::Long; +use Pod::Usage; + +my $man = 0; +my $help = 0; + +#Getopt::Long::Configure ("bundling"); # to allow -abc to set a, b, and c + +GetOptions ("help|?" => \$help, + man => \$man, + ) or pod2usage(2); + +pod2usage(-exitval => 0, -verbose => 1) if $help; +pod2usage(-exitval => 0, -verbose => 2) if $man; + open FILE, "$ARGV[0]" or die "Cannot open input file $ARGV[0]\n"; open FILEOUT, ">$ARGV[1]" or die "Cannot open output file $ARGV[1]\n"; @@ -16,7 +47,7 @@ while (<FILE>) { if ( $ARGV[2] != 3 ) { - s/\/\*.*\*\///g; + s/\/\*([^\/]|\/[^\*])*\*\///g; } @@ -29,3 +60,39 @@ while (<FILE>) { # } } + +__END__ + +=head1 UNLINE + +unline.pl - Remove B<C> comments from a file + +=head1 SYNOPSIS + +unline.pl [options] input_file output_file + + + Options: + --help|-h|-? brief help message + --man|-m full documentation + +=head1 OPTIONS + +=over 8 + +=item B<--help> + +Print a brief help message and exit. + +=item B<--man> + +Print the manual page and exit. + +=back + +=head1 DESCRIPTION + +B<unline.pl> will read the given <input_file>, remove the B<C> comments +and output the resulting file in <output_file> + +=cut |