code.delx.au - gnu-emacs/blob - lispref/tindex.pl

   1 #! /usr/bin/perl
   2
   3 # Copyright (C) 2000, 2002, 2003, 2004, 2005,
   4 #   2006 Free Software Foundation, Inc.
   5 #
   6 # This file is part of GNU Emacs.
   7 #
   8 # GNU Emacs is free software; you can redistribute it and/or modify
   9 # it under the terms of the GNU General Public License as published by
  10 # the Free Software Foundation; either version 2, or (at your option)
  11 # any later version.
  12 #
  13 # GNU Emacs is distributed in the hope that it will be useful,
  14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 # GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License
  19 # along with GNU Emacs; see the file COPYING.  If not, write to the
  20 # Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  21 # Boston, MA 02110-1301, USA.
  22
  23 require 5;
  24 use Getopt::Long;
  25
  26 my $USAGE = <<ENDUSAGE;
  27 Remove \@tindex lines from files that were already present in previous
  28 versions.
  29
  30 Usage: $0 [--old=EXT] FILE...
  31        $0 --help
  32        $0 --version
  33
  34   --help        display this help and exit
  35   --version     print version and exit
  36   --old=DIR     find old files in DIR
  37
  38 The script performs two passes.  In the first pass, Texinfo files from
  39 DIR are scanned for \@tindex lines, and identifiers in them are
  40 recorded.  In a second pass, Texinfo files in the current directory
  41 are scanned, and \@tindex lines for identifiers that were recorded in
  42 the first pass are removed.  Old file contents are saved in files
  43 with extension ".orig".  A list of modified files and removed \@tindex
  44 identifiers is printed to stdout at the end.
  45 ENDUSAGE
  46
  47 sub fatal {
  48     print STDERR "$0: ", @_, ".\n";
  49     exit 1;
  50 }
  51
  52 my $help = 0;
  53 my $version = 0;
  54 my $old;
  55
  56 my $rc = GetOptions ('help' => \$help, 'version' => \$version,
  57                      'old=s' => \$old);
  58 if ($version) {
  59     print "0.1\n";
  60     exit 0;
  61 } elsif (!$rc || !$old || @ARGV) {
  62     print $USAGE;
  63     exit 1;
  64 } elsif ($help) {
  65     print $USAGE;
  66     exit 0;
  67 }
  68
  69 # Fill the hash %tindex with associations VAR -> COUNT where
  70 # the keys VAR are identifiers mentioned in @tindex lines in the older
  71 # files to process and COUNT is the number of times they are seen in
  72 # the files.
  73
  74 my %tindex;
  75 my %removed;
  76 my @old_files = glob "$old/*.texi";
  77 my @new_files = glob "*.texi";
  78 fatal ("No Texinfo files found in `$old'") unless @old_files;
  79 fatal ("No Texinfo files found in current directory") unless @new_files;
  80
  81 print "Scanning old files for \@tindex lines\n";
  82 foreach $file (@old_files) {
  83     open (IN, "<$file") or fatal "Cannot open $file: $!";
  84     while (<IN>) {
  85         ++$tindex{$1} if /^\s*\@tindex\s+(\S+)/;
  86     }
  87     close IN;
  88 }
  89
  90 # Process current files and remove those @tindex lines which we
  91 # know were already present in the files scanned above.
  92
  93 print "Removing old \@tindex lines\n";
  94 foreach $file (@new_files) {
  95     my $modified = 0;
  96     my $contents = "";
  97
  98     open (IN, "< $file") or fatal "Cannot open $file.orig for reading: $!";
  99     while (<IN>) {
 100         if (/^\s*\@tindex\s+(\S+)/ && $tindex{$1}) {
 101             ++$removed{$1};
 102             $modified = 1;
 103         } else {
 104             $contents = $contents . $_;
 105         }
 106     }
 107
 108     close IN;
 109
 110     if ($modified) {
 111         print "  $file\n";
 112         system ("cp $file $file.orig") == 0 or fatal "Cannot backup $file: $!";
 113         open (OUT, ">$file") or fatal "Cannot open $file for writing: $!";
 114         print OUT $contents;
 115         close OUT;
 116     }
 117 }
 118
 119 # Print a list of identifiers removed.
 120
 121 print "Removed \@tindex commands for:\n";
 122 my $key;
 123 foreach $key (keys %removed) {
 124     print "  $key\n";
 125 }
 126
 127 # arch-tag: f8460df6-6bef-4c98-8555-e2c63a88b0fa