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