branch master updated: Generate automatically perl commands information hashes

[Patrice Dumas]

This is an automated email from the git hooks/post-receive script.

pertusus pushed a commit to branch master
in repository texinfo.

The following commit(s) were added to refs/heads/master by this push:
     new f70f5c11c1 Generate automatically perl commands information hashes
f70f5c11c1 is described below

commit f70f5c11c1f2749181e21c7539811ce54a1e7fd2
Author: Patrice Dumas <pertusus@free.fr>
AuthorDate: Sun Oct 2 16:53:26 2022 +0200

    Generate automatically perl commands information hashes
    
    * maintain/regenerate_perl_command_infos.pl, Makefile.am: generate
    automatically Texinfo/Commands.pm using the information from
    tp/Texinfo/XS/parsetexi/command_data.txt.
---
 .gitignore                                   |   1 +
 ChangeLog                                    |   8 ++
 tp/Makefile.am                               |   7 +-
 tp/Texinfo/XS/parsetexi/command_data.txt     |   2 +-
 tp/maintain/regenerate_perl_command_infos.pl | 105 +++++++++++++++++++++++++++
 5 files changed, 121 insertions(+), 2 deletions(-)

diff --git a/.gitignore b/.gitignore
index 01d1b08c21..0ff393dfb3 100644
--- a/.gitignore
+++ b/.gitignore
@@ -234,6 +234,7 @@ tp/*.log
 tp/*.html
 tp/test.*
 
+tp/Texinfo/Commands.pm
 tp/Texinfo/ModulePath.pm
 tp/Texinfo/*.html
 
diff --git a/ChangeLog b/ChangeLog
index 85c1d1453e..d7ae739206 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -6,6 +6,14 @@
        by the hyperref package.
        * tp/t/latex_tests.t (vbar_in_index): New test.
 
+2022-10-02  Patrice Dumas  <pertusus@free.fr>
+
+       Generate automatically perl commands information hashes
+
+       * maintain/regenerate_perl_command_infos.pl, Makefile.am: generate
+       automatically Texinfo/Commands.pm using the information from
+       tp/Texinfo/XS/parsetexi/command_data.txt.
+
 2022-10-02  Patrice Dumas  <pertusus@free.fr>
 
        Warn if @-commands other than accent, glyphs and symbols appear in @w
diff --git a/tp/Makefile.am b/tp/Makefile.am
index 6cddd245d0..d5954bac1a 100644
--- a/tp/Makefile.am
+++ b/tp/Makefile.am
@@ -80,7 +80,8 @@ dist_noinst_DATA = \
  Texinfo/ModulePath.pm.in
 
 modules_DATA = \
- Texinfo/ModulePath.pm
+ Texinfo/ModulePath.pm \
+ Texinfo/Commands.pm
 
 convertersdir = $(pkgdatadir)/Texinfo/Convert
 dist_converters_DATA = \
@@ -319,6 +320,10 @@ Texinfo/ModulePath.pm: Texinfo/ModulePath.pm.in Makefile
            -e 's|[@]USE_EXTERNAL_UNIDECODE[@]|$(USE_EXTERNAL_UNIDECODE)|' \
          $(srcdir)/Texinfo/ModulePath.pm.in >$@
 
+Texinfo/Commands.pm: Texinfo/XS/parsetexi/command_data.txt
+       $(MKDIR_P) Texinfo
+       $(srcdir)/maintain/regenerate_perl_command_infos.pl < $< > $@
+
 libsrcdir = $(srcdir)/maintain/lib
 
 install-data-local:
diff --git a/tp/Texinfo/XS/parsetexi/command_data.txt 
b/tp/Texinfo/XS/parsetexi/command_data.txt
index 207528af96..a067dabff3 100644
--- a/tp/Texinfo/XS/parsetexi/command_data.txt
+++ b/tp/Texinfo/XS/parsetexi/command_data.txt
@@ -20,7 +20,7 @@
 ##############################################################
 # Internal commands
 # invalid if not accept_internalvalue set in configuration
-txiinternalvalue        brace,internal                  INTERNAL_brace
+txiinternalvalue        internal,brace                  INTERNAL_brace
 
 ##############################################################
 # no brace commands - single letter commands
diff --git a/tp/maintain/regenerate_perl_command_infos.pl 
b/tp/maintain/regenerate_perl_command_infos.pl
new file mode 100755
index 0000000000..8c5d2d91e4
--- /dev/null
+++ b/tp/maintain/regenerate_perl_command_infos.pl
@@ -0,0 +1,105 @@
+#! /usr/bin/env perl
+
+# regenerate_perl_command_infos.pl: generate perl hashes based on
+# commands information setup for the XS parser.
+#
+# Copyright 2022 Free Software Foundation, Inc.
+#
+# This program 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.
+#
+# This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.
+
+use strict;
+
+# emulates -w
+BEGIN
+{
+  $^W = 1;
+}
+
+my %command_categories;
+my %flags_hashes;
+
+while (<>) {
+  if (not (/^#/ or /^ *$/)) {
+    my ($command, $flags, $data, $args_nr) = split;
+    my @flags = split /,/, $flags;
+    #print STDERR "$command, ".join('|',@flags).", $data, $args_nr\n";
+    my $category;
+    my $type = 'other';
+    if (defined($data) and $data ne '') {
+      if ($data =~ /^([A-Z]+)_([a-z_]+)$/) {
+        $category = lc($1);
+        $type = $2;
+      } else {
+        die "$command: abnormal data: $data\n";
+      }
+    }
+    if (defined($category)) {
+      $command_categories{$category} = {} if (!$command_categories{$category});
+      if (!grep {$_ eq $category} @flags) {
+        die "$command: ".join('|',@flags).": $category: not in flags\n";
+      }
+    } else {
+      my @categories = grep {exists($command_categories{$_})} @flags;
+      if (scalar(@categories) == 0) {
+        die "$command: ".join('|',@flags).": cannot find a category ("
+                          .join('|', sort(keys(%command_categories))).")\n";
+      } elsif (scalar(@categories) > 1) {
+        warn "$command: ".join('|',@flags)
+            .": multiple categories: ".join('|',@categories)."\n";
+      }
+      $category = $categories[0];
+    }
+    $command_categories{$category}->{$type} = []
+        if not ($command_categories{$category}->{$type});
+    push @{$command_categories{$category}->{$type}}, $command;
+    # gives the same result as {$_ ne $category} as the
+    # command with multiple categories, txiinternalvalue appears
+    # at the very beginning of the file
+    foreach my $flag (grep {not $command_categories{$_}} @flags) {
+      $flags_hashes{$flag} = [] if (!$flags_hashes{$flag});
+      push @{$flags_hashes{$flag}}, $command;
+    }
+  }
+}
+
+#open (OUT, ">Texinfo/Commands.pm") or die "Open Texinfo/Commands.pm: $!\n";
+
+print STDOUT "# Automatically generated from $0\n\n";
+
+print STDOUT "package Texinfo::Commands;\n\n";
+
+foreach my $category (sort(keys(%command_categories))) {
+  print STDOUT "our %${category}_commands = (\n";
+  foreach my $type (sort(keys(%{$command_categories{$category}}))) {
+    foreach my $command (sort(@{$command_categories{$category}->{$type}})) {
+      print STDOUT '  '.sprintf('%-25s', '"'.$command.'"')." => '$type',\n";
+    }
+  }
+  print STDOUT ");\n\n";
+}
+
+print STDOUT "\n";
+print STDOUT "# flag hashes\n";
+
+foreach my $hash_flag (sort(keys(%flags_hashes))) {
+  # happens for 'txiinternalvalue' which is also brace
+  next if ($command_categories{$hash_flag});
+  print STDOUT "our %${hash_flag}_commands = (\n";
+  foreach my $command (sort(@{$flags_hashes{$hash_flag}})) {
+    print STDOUT '  '.sprintf('%-25s', '"'.$command.'"')." => 1,\n";
+  }
+  print STDOUT ");\n\n";
+}
+
+print STDOUT "1;\n";