diff options
Diffstat (limited to 'Build/source/utils/xindy/make-rules/alphabets/make-rules.pl')
-rwxr-xr-x | Build/source/utils/xindy/make-rules/alphabets/make-rules.pl | 265 |
1 files changed, 265 insertions, 0 deletions
diff --git a/Build/source/utils/xindy/make-rules/alphabets/make-rules.pl b/Build/source/utils/xindy/make-rules/alphabets/make-rules.pl new file mode 100755 index 00000000000..a2b5040d5ed --- /dev/null +++ b/Build/source/utils/xindy/make-rules/alphabets/make-rules.pl @@ -0,0 +1,265 @@ +#!/usr/bin/perl + +open XDY,">$ARGV[0].xdy"; +open DOC,">$ARGV[0]-doc.tex"; +open TEST,">$ARGV[0].raw"; +open TESTXDY,">$ARGV[0]-test.xdy"; + +print XDY ";; Rules for xindy; generated by make-rules.pl\n"; +print XDY ";; language: $language\n\n"; + +if ($prefix) { + $prefix = $prefix . '-'; +} + +print TESTXDY "(require \"lang/$ARGV[0].xdy\")\n"; +print TESTXDY "(define-sort-rule-orientations (forward backward forward forward))\n"; +print TESTXDY "(use-rule-set :run 0\n"; +print TESTXDY " :rule-set (\"".$prefix."alphabetize\" \"".$prefix."ignore-special\"))\n"; +print TESTXDY "(use-rule-set :run 1\n"; +print TESTXDY " :rule-set (\"".$prefix."resolve-diacritics\" \"".$prefix."ignore-special\"))\n"; +print TESTXDY "(use-rule-set :run 2\n"; +print TESTXDY " :rule-set (\"".$prefix."resolve-case\" \"".$prefix."ignore-special\"))\n"; +print TESTXDY "(use-rule-set :run 3\n"; +print TESTXDY " :rule-set (\"".$prefix."resolve-special\"))\n"; +close TESTXDY; +system("cat test.xdy >> $ARGV[0]-test.xdy"); + +$begin = 128; +# $begin = 97 if ($script eq "cyrillic"); +# $begin = 150 if ($script eq "latin"); +# $begin = 65 if ($script eq "greek"); + +if (!$begin) { + $begin = 65; +} + +print "Alphabet has " . @{$alphabet} . " elements.\n"; + +for ($i = 0; $i < @{$alphabet}; $i++) { + if (defined($alphabet->[$i][0])) { + $letter = $alphabet->[$i][0]; + $lout = $letter; + $lout =~ s/\~/~~/g; + $lout =~ s/\"/~\"/g; + $token = chr($i+$begin); + $token =~ s/\~/~~/g; + $token =~ s/\"/~\"/g; + if ($after ne $letter) { + print XDY "\"))\n" if ($i); + print XDY "(define-letter-group \"$lout\""; + print XDY " :after \"$after\"" if ($i); + print XDY " :prefixes (\""; + } else { + print XDY "\" \""; + } + print XDY "$token"; + $after = $letter; + } +} + +print XDY "\"))\n\n"; + +$ref = \$i; +$offset = $begin; +$f = 1; +make_tokens(); + +# print test raw file +# alphabet + $p = 1; + foreach $letter (keys %tokens) { + print TEST "(indexentry :key (\"$letter\") :locref \"$p\")\n"; + $p++; + } +# end + +process_ligatures(); + +print_tokens($prefix . "alphabetize"); + +$ref = \$j; +$offset = 161; +$f = 1; +make_tokens(); + +for ($i = 0; $i < @{$ligatures}; $i++) { + if ($ligatures->[$i][1] eq "before") { + $token = chr(161); + } else { + $token = chr(255); + } + foreach $ligature_variant (@{$ligatures->[$i][0]}) { + $tokens{$ligature_variant} = $token; + } +} + +print_tokens($prefix . "resolve-diacritics"); + +$ref = \$k; +$offset = 48; +$f = 1; +if ($sortcase eq "Aa") { + $offset = 57; + $f = -1; +} + +make_tokens(); + +process_ligatures(); + +print_tokens($prefix . "resolve-case"); + +foreach $character (@special) { + $tokens{$character} = "" unless ($character eq "letters"); +} + +print_tokens($prefix . "ignore-special"); + +$offset = 161; +$f = 1; + +for ($l = 0; $l < @special; $l++) { + if (@special[$l] eq "letters") { + $ref = \$l; + make_tokens(); + process_ligatures(); + } else { + $token = chr($l+$offset); + $tokens{@special[$l]} = $token; + } +} + +print_tokens($prefix . "resolve-special"); + +# print doc: +# alphabet + for ($i = 0; $i < @{$alphabet}; $i++) { + for ($j = 1; $j < @{$alphabet->[$i]}; $j++) { + push @l,join("\\,", (@{$alphabet->[$i][$j]})); + } + if ((@l)) { + push @m, join(" & ", (@l)); + } +# push @m, "`".$alphabet->[$i][0]."':\\>".join(" -- ", (@l)); + @l = (); + } + print DOC "\\subsection{$language"; + print DOC " ($variant)" if ($variant); + print DOC "}\n\n"; + print DOC "\\subsubsection{Alphabet}\n"; + print DOC "\\icod\\fcod\n"; + print DOC "\\begin{alphabet}\n"; + print DOC join("\\\\\n", (@m)); + print DOC "\n\\end{alphabet}\n"; + print DOC "\\idef\\fdef\n"; + +# ligatures + print DOC "\n\\subsubsection{Ligatures}\n"; + print DOC "\\begin{flushleft}\n"; + print DOC "None.\n" unless @{$ligatures}; + @m = (); + for ($i = 0; $i < @{$ligatures}; $i++) { + for ($j = 0; $j < @{$ligatures->[$i][0]}; $j++) { + push @m, "`$ligatures->[$i][0][$j]' is sorted like `" . + join("\\,", (@{$ligatures->[$i][2][$j]})) . + "', but \\emph{$ligatures->[$i][1]} it in otherwise equal words."; + } + } + print DOC join("\\\\\n", (@m)); + print DOC "\n\\end{flushleft}\n"; + +# case + print DOC "\n\\subsubsection{Upper-/lowercase words}\n"; + if ($sortcase eq "Aa") { + print DOC "Capitalized or uppercase words are sorted \\emph{before} "; + print DOC "otherwise equal lowercase words.\n"; + } else { + print DOC "Capitalized or uppercase words are sorted \\emph{after} "; + print DOC "otherwise equal lowercase words.\n"; + } + +# special +print DOC "\n\\subsubsection{Special characters}\n"; +print DOC "The order of special characters and letters is:\n"; +print DOC "\\begin{flushleft}\n"; +print DOC join("\\hspace{4mm}", (@special)); +print DOC "\n\\end{flushleft}\n"; +print DOC "\\newpage\n"; + +# end + +# print test raw file + +# for ($i = 0; $i < @{$alphabet}; $i++) { +# for ($j = 1; $j < @{$alphabet->[$i]}; $j++) { +# foreach $letter (@{$alphabet->[$i][$j]}) { +# print TEST "(indexentry :key (\"$letter\") :locref \"$p\")\n"; +# $p++; +# } +# } +# } + +# ligatures + for ($i = 0; $i < @{$ligatures}; $i++) { + for ($j = 0; $j < @{$ligatures->[$i][0]}; $j++) { + print TEST + "(indexentry :key (\"$ligatures->[$i][0][$j]\") :locref \"$p\")\n"; + $p++; + print TEST "(indexentry :key (\"" . + join("", (@{$ligatures->[$i][2][$j]})) . "\") :locref \"$p\")\n"; + $p++; + } + } + +# special +foreach $letter (@special) { + if ($letter ne "letters") { + print TEST "(indexentry :key (\"$letter\") :locref \"$p\")\n"; + $p++; + } +} + +# end + +sub make_tokens { + for ($i = 0; $i < @{$alphabet}; $i++) { + for ($j = 1; $j < @{$alphabet->[$i]}; $j++) { + for ($k = 0; $k < @{$alphabet->[$i][$j]}; $k++) { + $token = chr($f*$$ref+$offset); + if ($alphabet->[$i][$j][$k]) { + $tokens{$alphabet->[$i][$j][$k]} = $token; + } + } + } + } +} + +sub process_ligatures { + for ($i = 0; $i < @{$ligatures}; $i++) { + for ($j = 0; $j < @{$ligatures->[$i][0]}; $j++) { + $token = ""; + foreach $ligature_component (@{$ligatures->[$i][2][$j]}) { + $token = $token.$tokens{$ligature_component}; + } + $tokens{$ligatures->[$i][0][$j]} = $token; + } + } +} + +sub print_tokens { + print XDY "(define-rule-set \"$_[0]\"\n\n :rules ("; + foreach $letter (sort { + (length($b) <=> length($a)) || ($tokens{$a} cmp $tokens{$b}) + } (keys %tokens)) { + $lout = $letter; + $lout =~ s/\~/~~/g; + $lout =~ s/\"/~\"/g; + $tout = $tokens{$letter}; + $tout =~ s/\~/~~/g; + $tout =~ s/\"/~\"/g; + print XDY "(\"$lout\" \"$tout\" :string)\n "; + } + print XDY "))\n\n"; + %tokens = (); +} |