path: root/Master/texmf-dist/scripts/mkgrkindex/mkgrkindex

#!/usr/bin/env perl
#
#(c) Copyright 1998-2009   Apostolos Syropoulos
#                          asyropoulos@yahoo.com
#
# The LaTeX Project Public License (lppl) 
# This software is copyright but you are granted a license which gives you, 
# the "user" of the software, legal permission to copy, distribute, and/or 
# modify the software. However, if you modify the software and then distribute 
# it (even just locally) you must change the name of the software, or use other 
# technical means to avoid confusion. 
#
$makeindex = "makeindex"; #name of the index generation utility
sub g2e
{
   $word = $_[0];
   $tword = "";
   foreach $_ (split(//, $word))
   {
     if    (/^a|^A|^á|^Á|^Ü|^\xA2|^\xB6/) { $tword .= "a";}
     elsif (/^b|^B|^â|^Â/)                { $tword .= "b"; }
     elsif (/^d|^D|^ä|^Ä/)                { $tword .= "d"; } 
     elsif (/^e|^E|^å|^Å|^Ý|^¸/)          { $tword .= "e"; }
     elsif (/^i|^I|^é|^É|^ß|^º|^À/)       { $tword .= "i"; }
     elsif (/^o|^O|^ï|^Ï|^ü|^¼/)          { $tword .= "o"; } 
     elsif (/^p|^P|^ð|^Ð/)                { $tword .= "p"; }
     elsif (/^g|^G|^ã|^Ã/)                { $tword .= "c"; }
     elsif (/^z|^Z|^æ|^Æ/)                { $tword .= "f"; }
     elsif (/^h|^H|^ç|^Ç|^Þ|^¹/)          { $tword .= "g"; }
     elsif (/^j|^J|^è|^È/)                { $tword .= "h"; }
     elsif (/^k|^K|^ê|^Ê/)                { $tword .= "j"; }
     elsif (/^l|^L|^ë|^Ë/)                { $tword .= "k"; }
     elsif (/^m|^M|^ì|^Ì/)                { $tword .= "l"; }
     elsif (/^n|^N|^í|^Í/)                { $tword .= "m"; }
     elsif (/^x|^X|^î|^Î/)                { $tword .= "n"; }
     elsif (/^r|^R|^ñ|^Ñ/)                { $tword .= "q"; }
     elsif (/^s|^c|^S|^ó|^ò|^Ó/)          { $tword .= "r"; }
     elsif (/^t|^T|^ô|^Ô/)                { $tword .= "s"; }
     elsif (/^u|^U|^õ|^Õ|^ý|^¾|^à/)       { $tword .= "t"; }
     elsif (/^f|^F|^ö|^Ö/)                { $tword .= "u"; }
     elsif (/^q|^Q|^÷|^×/)                { $tword .= "v"; }
     elsif (/^y|^Y|^ø|^Ø/)                { $tword .= "w"; }
     elsif (/^w|^W|^ù|^Ù|^þ|^¿/)          { $tword .= "x"; }
     elsif (/^'|^`|^~|^<|^>/)             {                }
     else                                 { $tword .= $_   }
   }
   return $tword;
}

$argc = @ARGV;

if ($argc == 0 || $argc > 4 ) # no command line arguments or more than 3
{                             # arguments
   die "Usage: mkgrkindex.pl [-s A|a] [-l] index\n";
}
else
{
   print "This is mkgrkindex (previously known as mkindex) version 2.0\n";
   
      $style = 0;
      $is_latin = 0;
       
         SWITCHES: 
         while($_ = $ARGV[0])
         {  
            shift;
            if (/^-s/)
            {
               if ($ARGV[0] eq "a")
               {
                  $style = -1;
               }
               elsif ($ARGV[0] eq "A")
               {
                  $style = 1;
               }
               else
               {
                  die "$ARGV[0]: Illegal argument for switch -s\n";
               }
               shift;  
            }
            elsif (/^-l/)
            {
               $is_latin = 1;
            }
            elsif (/^-\w+/)
            {
               die "$_: Illegal command line switch!\n";
            }
            else
            {
               $file = $_;
            } 
         }    
         die "No index file name specified!\n" if $file eq "";
            
         if (! (-e $file))
         {
             die "$file: no such file!\n" if $file =~ /.+\..+/;
             die "$file.idx: no such file!\n" if (! (-e "$file.idx"));
             $index_file = "$file.idx";
         }
         else
         {
             $index_file = $file;
             $file = $1 if $index_file =~ /(.+)\..+/; 
         }
   

}


$old_file="$index_file.old";

if ($is_latin == 0)
{
   rename $index_file, $old_file;
   open(OLD, "$old_file") || die "Can't open file $old_file\n";
   open(NEW, ">$index_file") || die "Can't open file $index_file\n";
   
   while (<OLD>)
   {
       #\x7B = {, \x7D = },\x40 = @, \x7C = |, \x21 = !, \x28 = (, \x29 = )
       chomp;
       #Nikos Platis has suggested to replace the original code with a better
       #parsing method. The code that follows is essentially Nikos's code with
       #some minnor modifications, as explained in the documentation.
       $newentry = "";
       /^\\indexentry\x7B(.+)\x7D(.+)/;
       $fullentry = $1;
       $page = $2;
       ($indexentry, $format) = split(/(?<!")\x7C/, $fullentry);
       @entryparts = split(/(?<!")\x21/, $indexentry);
       $numparts = @entryparts;
       for ($i = 0; $i < $numparts; $i++)  {
         ($x, $y) = split(/(?<!")\x40/, @entryparts[$i]);
         if ($i > 0)  {
           $newentry .= "!"
         }
         $tx = g2e($x);
         if ($y) {
           $newentry .= "$tx\@$y"
         }
         else {
           $newentry .= "$tx\@$x";
         }
       }
       print NEW "\\indexentry{$newentry";
       if ($format) {
         print NEW "|$format"
       }
       print NEW "}$page\n"
   }    

   close OLD;
   close NEW;
   unlink $old_file;
} 

rename $index_file, $old_file;
open(OLD, "$old_file") || die "Can't open file $old_file\n";
open(NEW, ">$index_file") || die "Can't open file $index_file\n";

while(<OLD>)
{
    chomp($_);
    if (/\\indexentry\x7B(.+)\x7D\x7B\\textlatin\s*?\x7B(\w+)\x7D\x7D/)
    {
       print NEW "\\indexentry{$1|textlatin}{$2}\n";
    }
    else
    {
       print NEW "$_\n";
    }
}


close OLD;
close NEW;
unlink $old_file;


if ($style < 0)
{
   system("$makeindex -s alpha.ist $file");
}
elsif ($style > 0)
{
   system("$makeindex -s Alpha.ist $file");
}
else
{
   system("$makeindex $file");
}

if ($style != 0)
{
   
   
   %e2g = (
             'a' => 'á', 'A' => 'Á',
             'b' => 'â', 'B' => 'Â',
             'c' => 'ã', 'C' => 'Ã',
             'd' => 'ä', 'D' => 'Ä',
             'e' => 'å', 'E' => 'Å',
             'f' => 'æ', 'F' => 'Æ',
             'g' => 'ç', 'G' => 'Ç',
             'h' => 'è', 'H' => 'È',
             'i' => 'é', 'I' => 'É',
             'j' => 'ê', 'J' => 'Ê',
             'k' => 'ë', 'K' => 'Ë',
             'l' => 'ì', 'L' => 'Ì',
             'm' => 'í', 'M' => 'Í',
             'n' => 'î', 'N' => 'Î',
             'o' => 'ï', 'O' => 'Ï',
             'p' => 'ð', 'P' => 'Ð',
             'q' => 'ñ', 'Q' => 'Ñ',
             'r' => 'óv', 'R' => 'Ó',
             's' => 'ô', 'S' => 'Ô',
             't' => 'õ', 'T' => 'Õ',
             'u' => 'ö', 'U' => 'Ö',
             'v' => '÷', 'V' => '×',
             'w' => 'ø', 'W' => 'Ø',
             'x' => 'ù', 'X' => 'Ù'
           );

   $ind_file = "$file.ind";
   $old_file="$ind_file.old";

   if ($is_latin == 0)
   {
      rename $ind_file, $old_file;
      open(OLD, "$old_file") || die "Can't open file $old_file\n";
      open(NEW, ">$ind_file") || die "Can't open file $ind_file\n";
      
      while (<OLD>)
      {
           if (/^{\\hfil (\w?) \\hfil}/)
           {
              $lettergr = $e2g{$1};
              print NEW "{\\hfil $lettergr \\hfil}\\nopagebreak\n";
           }
           else
           {
              print NEW ;
           }
      }

      close OLD;
      close NEW;
      unlink $old_file;
   }

   rename $ind_file, $old_file;
   open(OLD, "$old_file") || die "Can't open file $old_file\n";
   open(NEW, ">$ind_file") || die "Can't open file $ind_file\n";
   
   while (<OLD>)
   {
      if (/^\x7B\\hfil (\w)ymbols \\hfil\x7D/)
      {
          if ($1 eq "s")
          {
                 print NEW "{\\hfil \\textgreek{\\textbf{s'umbola}}";
                 print NEW "\\hfil}\\nopagebreak\n";
          }
          elsif ($1 eq "S")
          {
                 print NEW "{\\hfil \\textgreek{\\textbf{S'umbola}}";
                 print NEW "\\hfil}\\nopagebreak\n";
          }
          else
          {
             die "Illegal header $1 in .ind file\n";
          }
      }
      else
      {
         print NEW;
      }
   }

   close OLD;
   close NEW;
   unlink $old_file;

}
__END__