build-aux/cross-options.pl

   1 #! /usr/bin/env perl
   2
   3 # Generate a release announcement message.
   4
   5 # Copyright (C) 2007-2020 Free Software Foundation, Inc.
   6 #
   7 # This program is free software: you can redistribute it and/or modify
   8 # it under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation, either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # This program is distributed in the hope that it will be useful,
  13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
  19 #
  20 # Written by Akim Demaille.
  21
  22 use warnings;
  23 use 5.005;
  24 use strict;
  25
  26 my %option;
  27 my %directive;
  28 my $scanner = `grep -i '"%[a-z]' $ARGV[0]`;
  29 $scanner =~ s/"\[-_\]"/-/g;
  30 while (<STDIN>)
  31 {
  32     if (/^\s*             # Initial spaces.
  33         (?:(-\w),\s+)?    # $1: $short: Possible short option.
  34         (--[-\w]+)        # $2: $long:  Mandatory long option.
  35         (\[?)             # $3: $opt:   '[' iff the argument is optional.
  36         (?:=(\S+))?       # $4: $arg:   Possible argument name.
  37         \s                # Spaces.
  38         /x)
  39     {
  40         my ($short, $long, $opt, $arg) = ($1, $2, $3, $4);
  41         $short = '' if ! defined $short;
  42         $short = '-d' if $long eq '--defines' && ! $short;
  43         my $dir = '%' . substr($long, 2);
  44         if (index ($scanner, "\"$dir\"") < 0)
  45         {
  46           if ($long eq '--force-define') { $dir = '%define'; }
  47           else { $dir = ''; }
  48         }
  49         if ($arg)
  50         {
  51             # if $opt, $arg contains the closing ].
  52             substr ($arg, -1) = ''
  53                 if $opt eq '[';
  54             $arg = lc ($arg);
  55             my $dir_arg = $arg;
  56             # If the argument is complete (e.g., for --define[=NAME[=VALUE]]),
  57             # put each word in @var, to build @var{name}[=@var{value}], not
  58             # @var{name[=value]}].
  59             $arg =~ s/(\w+)/\@var{$1}/g;
  60             my $long_arg = "=$arg";
  61             if ($opt eq '[') {
  62               $long_arg = "[$long_arg]";
  63               $arg = "[$arg]";
  64             }
  65             # For arguments of directives: this only works if all arguments
  66             # are strings and have the same syntax as on the command line.
  67             if ($dir_arg eq 'name[=value]')
  68             {
  69                 # -D/-F do not add quotes to the argument.
  70                 $dir_arg =
  71                     $dir eq "%define"
  72                     ? '@var{name} [@var{value}]'
  73                     : '@var{name} ["@var{value}"]';
  74             }
  75             else
  76             {
  77                 $dir_arg =~ s/(\w+)/\@var{"$1"}/g;
  78                 $dir_arg = '[' . $dir_arg . ']'
  79                     if $opt eq '[';
  80             }
  81             $long = "$long$long_arg";
  82             $short = "$short $arg" if $short && $short ne '-d';
  83             $dir = "$dir $dir_arg" if $dir;
  84         }
  85         $option{$long} = $short;
  86         $directive{$long} = $dir;
  87     }
  88 }
  89
  90 my $sep = '';
  91 foreach my $long (sort keys %option)
  92 {
  93     # Couldn't find a means to escape @ in the format (for @item, @tab), so
  94     # pass it as a literal to print.
  95 format STDOUT =
  96 @item @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @tab @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @tab @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  97 {
  98   '@', '@option{' . $long . '}',
  99   '@', $option{$long} ? ('@option{' . $option{$long} . '}') : '',
 100   '@', $directive{$long} ? ('@code{' . $directive{$long} . '}') : ''
 101 }
 102 .
 103     write;
 104 }