Mercurial > emacs
annotate lispref/tindex.pl @ 70887:9de7d5cf6d99
(BASE_PURESIZE): Increase to 1210000.
author | Luc Teirlinck <teirllm@auburn.edu> |
---|---|
date | Wed, 24 May 2006 16:53:18 +0000 |
parents | 067115a6e738 |
children | 6d19c76d81c5 c5406394f567 |
rev | line source |
---|---|
27188 | 1 #! /usr/bin/perl |
2 | |
68648
067115a6e738
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64889
diff
changeset
|
3 # Copyright (C) 2000, 2002, 2003, 2004, 2005, |
067115a6e738
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64889
diff
changeset
|
4 # 2006 Free Software Foundation, Inc. |
27188 | 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 | |
64083 | 20 # Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
21 # Boston, MA 02110-1301, USA. | |
27188 | 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 | |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
27188
diff
changeset
|
56 my $rc = GetOptions ('help' => \$help, 'version' => \$version, |
27188 | 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 | |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
27188
diff
changeset
|
90 # Process current files and remove those @tindex lines which we |
27188 | 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 = ""; | |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
27188
diff
changeset
|
97 |
27188 | 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 } | |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
27188
diff
changeset
|
107 |
27188 | 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 | |
52401 | 127 # arch-tag: f8460df6-6bef-4c98-8555-e2c63a88b0fa |