#! /usr/bin/env perl

# generate_code_convert_data.pl: generate perl hashes and C structures
# based on data information on representation of commands as text and
# unicode characters
#
# Copyright 2024-2026 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 <https://www.gnu.org/licenses/>.

use strict;

use warnings;

use Encode;
use File::Basename;

my $program_name = basename($0);

my $commands_text_file = $ARGV[0];
die "Need an input file\n" if (!defined($commands_text_file));

open(CMD, $commands_text_file)
  or die "open $commands_text_file: $!";

# map name used in input file to character used for value and @-command name
my %input_string_map = (
 '\\t' => "\t",
 '\\n' => "\n",
 '\\x20' => ' ',
  '\"' => '"',
  '\\\\' => '\\',
);

# map to a string representing the character that can be used in double
# quoted string.
my %character_protected_string;
foreach my $command (keys(%input_string_map)) {
  my $character = $input_string_map{$command};
  if ($character ne ' ' and $character ne '"') {
    $character_protected_string{$input_string_map{$command}} = $command;
  }
}

my $map;
my %maps;
my %ordered_maps;
my $line = 1;
while (<CMD>) {
  if (not (/^ *#/ or /^ *$/)) {
    chomp;
    if (/^ *-- *(\S+)/) {
      $map = $1;
      if (!exists($maps{$map})) {
        $maps{$map} = {};
        $ordered_maps{$map} = [];
      }
    } elsif (defined($map)) {
      my $command;
      my $value = '';
      if (/^([^ ]+) +(.+)$/) {
        $command = $1;
        $value = $2;
        if (!defined($value) or $value =~ /^ +$/) {
          $value = '';
        }
      } elsif (/^([^ ]+)$/) {
        $command = $1;
      }
      my $command_name;
      if (exists($input_string_map{$command})) {
        $command_name = $input_string_map{$command};
      } else {
        $command_name = $command;
      }
      if (exists($input_string_map{$value})) {
        $value = $input_string_map{$value};
      }

      $maps{$map}->{$command_name} = $value;
      push @{$ordered_maps{$map}}, [$command_name, $value];
    }
  }
  $line++;
}

my $lang = $ARGV[1];
die "Need a programming language\n" if (!defined($lang));

my $perl_format = 0;
my $C_format = 0;
if ($lang eq 'perl') {
  $perl_format = 1;
} else {
  $C_format = 1;
}

my @commands_order = ('');

my %name_commands;
my $text_file = $ARGV[2];

die "Need a file for text tables\n" if (!defined($text_file));

open(TEXT, '>', $text_file) or die "Open $text_file: $!\n";

my $commands_text_base_name = basename($commands_text_file);

if ($perl_format) {
  print TEXT "# Automatically generated by $program_name\n";
  print TEXT "# Generated from $commands_text_base_name\n\n";

  print TEXT "package Texinfo::CommandsValues;\n\n";

  foreach my $map (sort(keys(%maps))) {
    print TEXT "our \%$map = (\n";
    my $ordered_map = $ordered_maps{$map};
    foreach my $command_value (@$ordered_map) {
      my ($command, $value) = @$command_value;
      my $command_double_quotes = 0;
      my $value_double_quotes = 0;
      if (exists($character_protected_string{$command})) {
        $command = $character_protected_string{$command};
        $command_double_quotes = 1;
      } elsif ($command eq "'") {
        $command_double_quotes = 1;
      }
      if (exists($character_protected_string{$value})) {
        $value = $character_protected_string{$value};
        $value_double_quotes = 1;
      } elsif ($value eq "'") {
        $value_double_quotes = 1;
      }
      my $command_code_string;
      if ($command_double_quotes) {
        $command_code_string = "\"$command\"";
      } else {
        $command_code_string = "'$command'";
      }
      my $value_code_string;
      if ($value_double_quotes) {
        $value_code_string = "\"$value\"";
      } else {
        $value_code_string = "'$value'";
      }
      print TEXT "    $command_code_string    => $value_code_string,\n";
    }
    print TEXT ");\n\n";
  }

  print print TEXT "1;\n";

  close(TEXT);
  exit(0);
}


# Remainder if for $C_format

sub _protect_char($) {
  my $char = shift;

  return '\\n' if ($char eq "\n");
  if (ord($char) < 127 and $char ne '\\' and $char ne '"') {
    return $char;
  }
  my $encoded = Encode::encode('UTF-8', $char);
  return join('', map {"\\x".sprintf("%02x",ord($_))} split('', $encoded));
}

my $unicode_diacritics = $maps{'unicode_diacritics'};

my ($normalization_file, $unicode_file, $commands_order_file);

$unicode_file = $ARGV[3];
  die "Need a file for unicode tables\n" if (!defined($unicode_file));

my $structuring_file = $ARGV[4];
die "Need a file for structuring tables\n" if (!defined($structuring_file));

my $converter_file = $ARGV[5];
die "Need a file for converter tables\n" if (!defined($converter_file));

$commands_order_file = $ARGV[6];
 die "Need a commands order input file\n" if (!defined($commands_order_file));

open(ORDER, $commands_order_file)
  or die "open $commands_order_file: $!";
  
while (<ORDER>) {
  my $command;
  if (/^{"([^"]+?)", /) {
    $command = $1;
  } elsif (/^{"\\"", /) {
    $command = '\"';
  }
  next if (!defined($command));
  my $command_name = $command;
  if (exists($input_string_map{$command})) {
    $command_name = $input_string_map{$command};
    $name_commands{$command_name} = $command;
  }
  push @commands_order, $command_name;
  #print STDERR "$command\n";
}

open(UNIC, '>', $unicode_file) or die "Open $unicode_file: $!\n";

print UNIC "/* Automatically generated by $program_name */\n";
print UNIC "/* Generated from $commands_text_base_name */\n\n";

print UNIC "#include \"unicode.h\"\n\n";
print UNIC "const DIACRITIC_UNICODE unicode_diacritics[] = {\n";

foreach my $command_name (@commands_order) {
  my $command = $command_name;
  if (exists($name_commands{$command_name})) {
    $command = $name_commands{$command_name};
  }

  if (exists($unicode_diacritics->{$command_name})) {
    my $numeric_codepoint = hex($unicode_diacritics->{$command_name});
    my $result = chr($numeric_codepoint);
    my $protected = join ('', map {_protect_char($_)} split ('', $result));
    print UNIC "{\"$protected\", \"$numeric_codepoint\","
              ." \"$unicode_diacritics->{$command_name}\"},  /* $command */\n";
  } else {
    print UNIC "{0, 0, 0},\n";
  }
}
print UNIC "};\n\n";

# sets up a mapping with characters based on a mapping with
# hexadecimal string representation.
sub _unicode_characters_map($) {
  my $unicode_map = shift;

  my $result = {};

  foreach my $command (keys(%$unicode_map)) {
  # NOTE should be synced with the perl/Texinfo/Convert/Unicode.pm
  # code setting unicode_character_brace_no_arg_commands
    my $char_nr = hex($unicode_map->{$command});
    if ($char_nr > 126 and $char_nr < 255) {
      # this is very strange, indeed.  The reason lies certainly in the
      # magic backward compatibility support in Perl for 8bit encodings.
      $result->{$command} =
         Encode::decode("iso-8859-1", chr($char_nr));
    } else {
      $result->{$command} = chr($char_nr);
    }
  }
  return $result;
}

foreach my $map ('base_unicode_map', 'extra_unicode_map') {
  my $unicode_map = $maps{$map};
  my $unicode_chars_map = _unicode_characters_map($unicode_map);
  print UNIC "const COMMAND_UNICODE_CHARACTER $map\[] = {\n";
  foreach my $command_name (@commands_order) {
    my $command = $command_name;
    if (exists($name_commands{$command_name})) {
       $command = $name_commands{$command_name};
    }
    #print UNIC "$command; ";

    if (exists($unicode_map->{$command_name})) {
      my $encoded_character = $unicode_chars_map->{$command_name};
      my $protected = '"'.join ('', map {_protect_char($_)} split ('', $encoded_character)).'"';
      my $codepoint = '"'.$unicode_map->{$command_name}.'"';
      # note that this is not used for ASCII characters and some specific
      # characters.
      # This could be constructed in C, but having it in a const table
      # avoids the need to allocate memory.
      my $css_string = '"\\\\'.$unicode_map->{$command_name}.' "';
      print UNIC "{$codepoint, $protected, $css_string},   /* $command */\n";
    } else {
      print UNIC "{0, 0, 0},\n";
    }
  }
  print UNIC "};\n\n";
}

close(UNIC);

my $nobrace_symbol_text = $maps{'nobrace_symbol_text'};

print TEXT "/* Automatically generated from $program_name */\n";
print TEXT "/* Generated from $commands_text_base_name */\n\n";

print TEXT "#include <config.h>\n\n";
print TEXT "#include \"convert_to_text.h\"\n\n";

print TEXT "const char *nobrace_symbol_text[] = {\n";
foreach my $command_name (@commands_order) {
  my $command = $command_name;
  if (exists($name_commands{$command_name})) {
    $command = $name_commands{$command_name};
  }
  if (defined($nobrace_symbol_text->{$command_name})) {
    my $symbol = $nobrace_symbol_text->{$command_name};
    my $protected = join ('', map {_protect_char($_)} split ('', $symbol));
    print TEXT "\"$protected\",   /* $command */\n";
  } else {
    print TEXT "0,\n";
  }
}
print TEXT "};\n\n";

my $text_brace_no_arg_commands = $maps{'text_brace_no_arg_commands'};

print TEXT "const char *text_brace_no_arg_commands[] = {\n";
foreach my $command_name (@commands_order) {
  my $command = $command_name;
  if (exists($name_commands{$command_name})) {
    $command = $name_commands{$command_name};
  }
  if (defined($text_brace_no_arg_commands->{$command_name})) {
    my $result = $text_brace_no_arg_commands->{$command_name};
    my $protected = join ('', map {_protect_char($_)} split ('', $result));
    print TEXT "\"$protected\",   /* $command */\n";
  } else {
    print TEXT "0,\n";
  }
}
print TEXT "};\n\n";

my $sort_brace_no_arg_commands = $maps{'sort_brace_no_arg_commands'};

print TEXT "const char *sort_brace_no_arg_commands[] = {\n";
foreach my $command_name (@commands_order) {
  my $command = $command_name;
  if (exists($name_commands{$command_name})) {
    $command = $name_commands{$command_name};
  }
  if (defined($sort_brace_no_arg_commands->{$command_name})) {
    my $result = $sort_brace_no_arg_commands->{$command_name};
    my $protected = join ('', map {_protect_char($_)} split ('', $result));
    print TEXT "\"$protected\",   /* $command */\n";
  } else {
    print TEXT "0,\n";
  }
}
print TEXT "};\n\n";

close(TEXT);

my $command_structuring_level = $maps{'command_structuring_level'};

open(STRUC, '>', $structuring_file) or die "Open $structuring_file: $!\n";

print STRUC "/* Automatically generated from $program_name */\n";
print STRUC "/* Generated from $commands_text_base_name */\n\n";

print STRUC "#include \"command_ids.h\"\n\n";
print STRUC "int const command_structuring_level[] = {\n";
foreach my $command_name (@commands_order) {
  my $command = $command_name;
  if (exists($name_commands{$command_name})) {
    $command = $name_commands{$command_name};
  }
  if (defined($command_structuring_level->{$command_name})) {
    print STRUC "$command_structuring_level->{$command_name},  /* $command */\n";
  } else {
    print STRUC "-1,\n";
  }
}
print STRUC "};\n\n";

close (STRUC);

my $xml_text_entity_no_arg_commands = $maps{'xml_text_entity_no_arg_commands'};

open(CONV, '>', $converter_file) or die "Open $converter_file: $!\n";

print CONV "/* Automatically generated by $program_name */\n";
print CONV "/* Generated from $commands_text_base_name */\n\n";

print CONV "const char *xml_text_entity_no_arg_commands[] = {\n";
foreach my $command_name (@commands_order) {
  my $command = $command_name;
  if (exists($name_commands{$command_name})) {
    $command = $name_commands{$command_name};
  }
  #print CONV "$command; ";

  my $result = $xml_text_entity_no_arg_commands->{$command_name};

  if (defined($result)) {
    my $protected = join ('', map {_protect_char($_)} split ('', $result));
    print CONV "\"$protected\",  /* $command */\n";
  } else {
    print CONV "0,\n";
  }
}
print CONV "};\n\n";

close(CONV);

