summaryrefslogtreecommitdiff
path: root/macros/texinfo/texinfo/tp/Texinfo/Convert/NodeNameNormalization.pm
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
committerNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
commite0c6872cf40896c7be36b11dcc744620f10adf1d (patch)
tree60335e10d2f4354b0674ec22d7b53f0f8abee672 /macros/texinfo/texinfo/tp/Texinfo/Convert/NodeNameNormalization.pm
Initial commit
Diffstat (limited to 'macros/texinfo/texinfo/tp/Texinfo/Convert/NodeNameNormalization.pm')
-rw-r--r--macros/texinfo/texinfo/tp/Texinfo/Convert/NodeNameNormalization.pm337
1 files changed, 337 insertions, 0 deletions
diff --git a/macros/texinfo/texinfo/tp/Texinfo/Convert/NodeNameNormalization.pm b/macros/texinfo/texinfo/tp/Texinfo/Convert/NodeNameNormalization.pm
new file mode 100644
index 0000000000..ca460170b6
--- /dev/null
+++ b/macros/texinfo/texinfo/tp/Texinfo/Convert/NodeNameNormalization.pm
@@ -0,0 +1,337 @@
+# NodeNameNormalization.pm: output tree as normalized node name.
+#
+# Copyright 2010, 2011, 2012, 2016, 2017, 2018 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/>.
+#
+# Original author: Patrice Dumas <pertusus@free.fr>
+
+# the rules for conversion are decribed in the Texinfo manual, for
+# HTML crossrefs.
+
+package Texinfo::Convert::NodeNameNormalization;
+
+use 5.00405;
+use strict;
+
+use Unicode::Normalize;
+use Text::Unidecode;
+# for the accents definition
+use Texinfo::Common;
+# reuse some conversion hashes
+use Texinfo::Convert::Text;
+# use the hashes and functions
+use Texinfo::Convert::Unicode;
+
+require Exporter;
+use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+@ISA = qw(Exporter);
+
+%EXPORT_TAGS = ( 'all' => [ qw(
+ normalize_node
+ transliterate_texinfo
+) ] );
+
+@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
+
+@EXPORT = qw(
+);
+
+my %normalize_node_brace_no_arg_commands
+ = %Texinfo::Convert::Text::text_brace_no_arg_commands;
+foreach my $command (keys(%Texinfo::Convert::Unicode::unicode_character_brace_no_arg_commands)) {
+ $normalize_node_brace_no_arg_commands{$command} =
+ $Texinfo::Convert::Unicode::unicode_character_brace_no_arg_commands{$command};
+}
+
+my %normalize_node_no_brace_commands
+ = %Texinfo::Common::no_brace_commands;
+$normalize_node_no_brace_commands{'*'} = ' ';
+
+my %accent_commands = %Texinfo::Common::accent_commands;
+
+my %ignored_brace_commands;
+foreach my $ignored_brace_command ('anchor', 'footnote', 'shortcaption',
+ 'caption', 'hyphenation') {
+ $ignored_brace_commands{$ignored_brace_command} = 1;
+}
+
+my %ignored_types;
+foreach my $type ('empty_line_after_command', 'preamble',
+ 'empty_spaces_after_command', 'spaces_at_end',
+ 'empty_spaces_before_argument', 'empty_spaces_before_paragraph',
+ 'space_at_end_menu_node',
+ 'empty_spaces_after_close_brace') {
+ $ignored_types{$type} = 1;
+}
+
+
+sub normalize_node($)
+{
+ my $root = shift;
+ my $result = convert($root);
+ $result = Unicode::Normalize::NFC($result);
+ $result = _unicode_to_protected($result);
+ $result = 'Top' if ($result =~ /^Top$/i);
+ return $result;
+}
+
+sub transliterate_texinfo($;$)
+{
+ my $root = shift;
+ my $no_unidecode = shift;
+ my $result = convert($root);
+ $result = Unicode::Normalize::NFC($result);
+ $result = _unicode_to_protected(
+ _unicode_to_transliterate($result, $no_unidecode));
+ return $result;
+}
+
+sub convert($)
+{
+ my $root = shift;
+ my $result = _convert($root);
+}
+
+sub _unicode_to_protected($)
+{
+ my $text = shift;
+ my $result = '';
+ while ($text ne '') {
+ if ($text =~ s/^([A-Za-z0-9]+)//o) {
+ $result .= $1;
+ } elsif ($text =~ s/^ //o) {
+ $result .= '-';
+ } elsif ($text =~ s/^(.)//o) {
+ my $char = $1;
+ if (exists($Texinfo::Convert::Unicode::unicode_simple_character_map{$char})) {
+ $result .= '_' . lc($Texinfo::Convert::Unicode::unicode_simple_character_map{$char});
+ } else {
+ if (ord($char) <= hex(0xFFFF)) {
+ $result .= '_' . lc(sprintf("%04x",ord($char)));
+ } else {
+ $result .= '__' . lc(sprintf("%06x",ord($char)));
+ }
+ }
+ } else {
+ warn "Bug: unknown character _unicode_to_protected (likely in infinite loop)\n";
+ print STDERR "Text: !!$text!!\n";
+ sleep 1;
+ }
+ }
+ return $result;
+}
+
+sub _unicode_to_transliterate($;$)
+{
+ my $text = shift;
+ my $no_unidecode = shift;
+ if (chomp($text)) {
+ warn "Bug: end of line to transliterate: $text\n";
+ }
+ my $result = '';
+ while ($text ne '') {
+ if ($text =~ s/^([A-Za-z0-9 ]+)//o) {
+ $result .= $1;
+ } elsif ($text =~ s/^(.)//o) {
+ my $char = $1;
+ if (exists($Texinfo::Convert::Unicode::unicode_simple_character_map{$char})) {
+ $result .= $char;
+ } elsif (ord($char) <= hex(0xFFFF)
+ and exists($Texinfo::Convert::Unicode::transliterate_map{uc(sprintf("%04x",ord($char)))})) {
+ $result .= $Texinfo::Convert::Unicode::transliterate_map{uc(sprintf("%04x",ord($char)))};
+ } elsif (ord($char) <= hex(0xFFFF)
+ and exists($Texinfo::Convert::Unicode::diacritics_accent_commands{uc(sprintf("%04x",ord($char)))})) {
+ $result .= '';
+ # in this case, we want to avoid calling unidecode, as we are sure
+ # that there is no useful transliteration of the unicode character
+ # instead we want to keep it as is.
+ # This is the case, for example, for @exclamdown, is corresponds
+ # with x00a1, but unidecode transliterates it to a !, we want
+ # to avoid that and keep x00a1.
+ } elsif (ord($char) <= hex(0xFFFF)
+ and exists($Texinfo::Convert::Unicode::no_transliterate_map{uc(sprintf("%04x",ord($char)))})) {
+ $result .= $char;
+ } else {
+ if ($no_unidecode) {
+ if (ord($char) <= hex(0xFFFF)
+ and exists ($Texinfo::Convert::Unicode::transliterate_accent_map{uc(sprintf("%04x",ord($char)))})) {
+ $result .= $Texinfo::Convert::Unicode::transliterate_accent_map{uc(sprintf("%04x",ord($char)))};
+ } else {
+ $result .= $char;
+ }
+ } else {
+ $result .= unidecode($char);
+ }
+ }
+ #print STDERR " ($no_unidecode) $text -> CHAR: ".ord($char)." ".uc(sprintf("%04x",ord($char)))."\n$result\n";
+ } else {
+ warn "Bug: unknown character _unicode_to_transliterate (likely in infinite loop)\n";
+ print STDERR "Text: !!$text!!\n";
+ sleep 1;
+ }
+ }
+ return $result;
+}
+
+
+
+sub _convert($;$);
+
+sub _convert($;$)
+{
+ my $root = shift;
+ my $in_sc = shift;
+
+ return '' if (($root->{'type'} and $ignored_types{$root->{'type'}})
+ or ($root->{'cmdname'}
+ and ($ignored_brace_commands{$root->{'cmdname'}}
+ # here ignore the line commands
+ or ($root->{'args'} and $root->{'args'}->[0]
+ and $root->{'args'}->[0]->{'type'}
+ and ($root->{'args'}->[0]->{'type'} eq 'line_arg'
+ or $root->{'args'}->[0]->{'type'} eq 'misc_arg')))));
+ my $result = '';
+ if (defined($root->{'text'})) {
+ $result = $root->{'text'};
+ $result =~ s/\s+/ /go;
+ $result = uc($result) if ($in_sc);
+ }
+ if ($root->{'cmdname'}) {
+ my $command = $root->{'cmdname'};
+ if (defined($normalize_node_no_brace_commands{$root->{'cmdname'}})) {
+ return $normalize_node_no_brace_commands{$root->{'cmdname'}};
+ } elsif (defined($normalize_node_brace_no_arg_commands{$root->{'cmdname'}})) {
+ $command = $root->{'extra'}->{'clickstyle'}
+ if ($root->{'extra'}
+ and defined($root->{'extra'}->{'clickstyle'})
+ and defined($normalize_node_brace_no_arg_commands{$root->{'extra'}->{'clickstyle'}}));
+ my $result = $normalize_node_brace_no_arg_commands{$command};
+ if ($in_sc and $Texinfo::Common::letter_no_arg_commands{$command}) {
+ $result = uc($result);
+ }
+ return $result;
+ # commands with braces
+ } elsif ($accent_commands{$root->{'cmdname'}}) {
+ return '' if (!$root->{'args'});
+ my $accent_text = _convert($root->{'args'}->[0]);
+ my $accented_char
+ = Texinfo::Convert::Unicode::unicode_accent($accent_text,
+ $root);
+ if (!defined($accented_char)) {
+ # In this case, the node normalization do not follow the specification,
+ # but we cannot do better
+ $accented_char = Texinfo::Convert::Text::ascii_accent($accent_text,
+ $root);
+ }
+ if ($in_sc) {
+ return uc ($accented_char);
+ } else {
+ return $accented_char;
+ }
+ #} elsif ($root->{'cmdname'} eq 'image') {
+ # return _convert($root->{'args'}->[0]);
+ } elsif ($Texinfo::Common::ref_commands{$root->{'cmdname'}}) {
+ my @args_try_order;
+ if ($root->{'cmdname'} eq 'inforef') {
+ @args_try_order = (0, 1, 2);
+ } else {
+ @args_try_order = (0, 1, 2, 4, 3);
+ }
+ foreach my $index (@args_try_order) {
+ if (defined($root->{'args'}->[$index])) {
+ my $text = _convert($root->{'args'}->[$index]);
+ return $text if (defined($text) and $text =~ /\S/);
+ }
+ }
+ return '';
+ # Here all the commands with args are processed, if they have
+ # more than one arg the first one is used.
+ } elsif ($root->{'args'} and $root->{'args'}->[0]
+ and (($root->{'args'}->[0]->{'type'}
+ and $root->{'args'}->[0]->{'type'} eq 'brace_command_arg')
+ or $root->{'cmdname'} eq 'math')) {
+ my $sc = 1 if ($root->{'cmdname'} eq 'sc' or $in_sc);
+ return _convert($root->{'args'}->[0], $sc);
+ }
+ }
+ if ($root->{'contents'}) {
+ foreach my $content (@{$root->{'contents'}}) {
+ $result .= _convert($content, $in_sc);
+ }
+ }
+ $result = '{'.$result.'}'
+ if ($root->{'type'} and $root->{'type'} eq 'bracketed');
+ return $result;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Texinfo::Convert::NodeNameNormalization - Normalize and transliterate Texinfo trees
+
+=head1 SYNOPSIS
+
+ use Texinfo::Convert::NodeNameNormalization qw(normalize_node
+ transliterate_texinfo);
+
+ my $normalized = normalize_node({'contents' => $node_contents});
+
+ my $file_name = transliterate_texinfo({'contents'
+ => $section_contents});
+
+=head1 DESCRIPTION
+
+Texinfo::Convert::NodeNameNormalization allows to normalize node names,
+with C<normalize_node> following the specification described in the
+Texinfo manual for HTML Xref. This is usefull each time one want a
+unique identifier for Texinfo content that is only composed of letter,
+digits, C<-> and C<_>. In C<Texinfo::Parser> C<normalize_node> is used
+for node, floats and anchor names normalization, but also float
+types C<@acronym> and C<@abbr> first argument.
+
+It is also possible to transliterate non ascii letters, instead of mangling
+them, with C<transliterate_texinfo>, losing the uniqueness feature of
+normalized node names.
+
+=head1 METHODS
+
+=over
+
+=item $normalized = normalize_node($tree)
+
+The Texinfo I<$tree> is returned as a string, normalized as described in the
+Texinfo manual for HTML Xref.
+
+The result will be poor for Texinfo trees which are not @-command arguments
+(on an @-command line or in braces), for instance if the tree contains
+C<@node> or block commands.
+
+=item $transliterated = transliterate_texinfo($tree, $no_unidecode)
+
+The Texinfo I<$tree> is returned as a string, with non ascii letters
+transliterated as ascii, but otherwise similar with C<normalize_node>
+output. If the optional I<$no_unidecode> argument is set, C<Text::Unidecode>
+is not used for characters whose transliteration is not built-in.
+
+=back
+
+=head1 AUTHOR
+
+Patrice Dumas, E<lt>pertusus@free.frE<gt>
+
+=cut