Commit | Line | Data |
---|---|---|
dfc16043 GM |
1 | #! /usr/bin/perl |
2 | ||
b3d90e46 | 3 | # Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, |
57ebf0be | 4 | # 2006, 2007, 2008 Free Software Foundation, Inc. |
dfc16043 GM |
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 | |
eeddf09b | 10 | # the Free Software Foundation; either version 3, or (at your option) |
dfc16043 GM |
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 | |
364c38d3 LK |
20 | # Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
21 | # Boston, MA 02110-1301, USA. | |
dfc16043 GM |
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 | ||
177c0ea7 | 56 | my $rc = GetOptions ('help' => \$help, 'version' => \$version, |
dfc16043 GM |
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 | ||
177c0ea7 | 90 | # Process current files and remove those @tindex lines which we |
dfc16043 GM |
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 = ""; | |
177c0ea7 | 97 | |
dfc16043 GM |
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 | } | |
177c0ea7 | 107 | |
dfc16043 GM |
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 | ||
ab5796a9 | 127 | # arch-tag: f8460df6-6bef-4c98-8555-e2c63a88b0fa |