diff options
Diffstat (limited to 'Master/texmf-dist/source/latex/koma-script/genindex.pl')
-rw-r--r-- | Master/texmf-dist/source/latex/koma-script/genindex.pl | 197 |
1 files changed, 197 insertions, 0 deletions
diff --git a/Master/texmf-dist/source/latex/koma-script/genindex.pl b/Master/texmf-dist/source/latex/koma-script/genindex.pl new file mode 100644 index 00000000000..dc17a23bb72 --- /dev/null +++ b/Master/texmf-dist/source/latex/koma-script/genindex.pl @@ -0,0 +1,197 @@ +#! /usr/bin/perl -w +eval 'exec perl -S $0 ${1+"$@"}' + if 0; #$running_under_some_shell + +# ====================================================================== +# genindex.pl +# Copyright (c) Markus Kohm, 2002 +# +# This file is part of the LaTeX2e KOMA-Script-Bundle +# +# This file can be redistributed and/or modified under the terms +# of the LaTeX Project Public License Version 1.0 distributed +# together with this file. See LEGAL.TXT or LEGALDE.TXT. +# +# This bundle is written specialy for use at german-language. So the +# main documentation is german. There is also a english documentation, +# but this is NOT up-to-date. +# ---------------------------------------------------------------------- +# genindex.pl +# Copyright (c) Markus Kohm, 2002 +# +# Diese Datei ist Teil des LaTeX2e KOMA-Script-Pakets. +# +# Diese Datei kann nach den Regeln der LaTeX Project Public +# Licence Version 1.0, wie sie zusammen mit dieser Datei verteilt +# wird, weiterverbreitet und/oder modifiziert werden. Siehe dazu +# auch LEGAL.TXT oder LEGALDE.TXT. +# +# Dieses Paket ist fuer den deutschen Sprachraum konzipiert. Daher ist +# auch diese Anleitung komplett in Deutsch. Zwar existiert auch eine +# englische Version der Anleitung, diese hinkt der deutschen Anleitung +# jedoch fast immer hinterher. +# ====================================================================== +# This perl scripts splits the index of scrguide or scrguien into +# several files, each with one index section. +# +# Usage: genindex.pl <ind-file> +# +# If <ind-file> has no extension ``.ind'', this extension will be added. +# ---------------------------------------------------------------------- +# Dieses perl Script spaltet den Index des scrguide in mehrere getrennte +# Dateien auf, von denen jede jeweils einen Index-Abschnitt enthält. +# +# Verwendung: genindex.pl <ind-Datei> +# +# Wenn die <ind-Datei> ohne Endung ".ind" angegeben wird, so wird diese +# Endung automatisch angehängt. +# ====================================================================== + +use strict; +use Fcntl; + +my $indexinput = $ARGV[0]; +my $indexbase; +my $line; +my $entry = ""; +my %indfile; + +$indexinput = "$indexinput.ind" if ( ! ( $indexinput =~ /^.*\.ind\z/ ) ); +$indexbase = $1 if $indexinput =~ /^(.*)\.ind/; + +print "Generate multiindex for $indexinput\n"; + +# pass 1: search for and open destination index files +open (IDX, "<$indexinput") || + die "Cannot open $indexinput for reading\n"; +print "Search for index:\n"; +while ( <IDX> ) { + if ( /\\UseIndex *\{([^\}]*)\}/ ) { + my $file; + if ( !$indfile{"$1"} ) { + print " Open new index $indexbase-$1.ind\n"; + open ( $file, ">$indexbase-$1.ind" ) || + die "Cannot open $indexbase-$1.ind for writing\n"; + $indfile{"$1"} = $file; + } + } +} +# we must have a general index +if ( !$indfile{"gen"} ) { + print " Open new index $indexbase-gen.ind\n" ; + open ( $indfile{"gen"}, ">indexbase-gen.ind" ) || + die "Cannot open $indexbase-gen.ind for writing\n"; +} + +# pass 2: copy to destination index files +seek (IDX, 0, 0) || + die "Cannot rewind $indexinput\n"; +print "Copy entries:\n"; +# step 1: copy to every index file until first \indexsectione +while ( defined( ( $line = <IDX> ) ) + && ( ! ( $line =~ /^( *\\indexsection *\{)/ ) ) ) { + printtoallind( "$line" ); + $line = ""; +} +# copy also \indexsection-line +printtoallind( "$line" ); + +# step 2: read complete \indexsection, \indexspace, \item, \subitem or +# \subsubitem and process it (= copy it to destination index files) +while ( $line = <IDX> ) { + if ( $line =~ /^ *((\\indexsection|\\end) *\{|\\indexspace)/ ) { + processentry( "$entry" ); + $entry = ""; + printtoallind( "$line" ); + } elsif ( $line =~ /^ *\\(sub(sub)?)?item +/ ) { + processentry( "$entry" ); + $entry = $line; + } else { + $entry = "$entry$line"; + } +} + +close (IDX); +closeallind (); + +# post optimization of all destination index files +print "Optimize every index:\n"; +optimizeallind (); + +exit; + +# close all destination index files +sub closeallind { + my $name; + my $file; + while (($name,$file) = each %indfile) { + print " Close $indexbase-$name.ind\n" ; + close ($file); + $indfile{"$name"}=0; + } +} + +# optimize all destination index files +sub optimizeallind { + my $name; + my $file; + while (($name,$file) = each %indfile) { + print " $indexbase-$name.ind\n"; + optimizeind( "$name" ); + } +} + +# print arg 1 to all destination index files +sub printtoallind { + my $line = shift; + my $name; + my $file; + while (($name,$file) = each %indfile) { + print ($file $line); + } +} + +# process an index entry (copy it to valid destination index files) +sub processentry { + my $line = shift; + my $file = $indfile{"gen"}; + if ( $line =~ /\\UseIndex *\{([^\}]*)\} *(.*)/ ) { + $file = $indfile{"$1"}; + print ($file $line); + } else { + print ($file $line); + } +} + +# optimize an index files (remove \indexsection without \item) +sub optimizeind { + my $idx = shift; + my $interstuff = ""; + my $line; + + open (IN, "<$indexbase-$idx.ind" ) || + die "Cannot open $indexbase-$idx.ind for reading"; + open (OUT, ">$indexbase-$idx.new" ) || + die "Cannot open $indexbase-$idx.new for writing"; + + while ( $line=<IN> ) { + if ( $line =~ /^ *\\indexspace/ ) { + $interstuff = "\n$line"; + } elsif ( ( $line =~ /^ *\\indexsection *\{/ ) || + ( $line =~ /^$/ ) ) { + $interstuff = "$interstuff$line"; + } else { + print (OUT $interstuff) if ( !( $interstuff =~ /^$/ ) + && !( $line =~ /^ *\\end\{theindex\}/ ) ); + $interstuff = ""; + print (OUT $line); + } + } + + close (OUT); + close (IN); + unlink "$indexbase-$idx.ind" || + die "Cannot delete $indexbase-$idx.ind"; + rename "$indexbase-$idx.new", "$indexbase-$idx.ind" || + die "Cannot rename $indexbase-$idx.new to §indexbase-$idx.ind"; +} |