Mercurial > emacs
annotate doc/lispref/tindex.pl @ 98383:fb8c41cd17c4
*** empty log message ***
author | Martin Rudalics <rudalics@gmx.at> |
---|---|
date | Sun, 28 Sep 2008 08:43:50 +0000 |
parents | fde6f792a832 |
children | cb5d2387102c |
rev | line source |
---|---|
84104 | 1 #! /usr/bin/perl |
2 | |
95035
fde6f792a832
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
3 # Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, |
fde6f792a832
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
4 # 2008 Free Software Foundation, Inc. |
fde6f792a832
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
5 |
84104 | 6 # This file is part of GNU Emacs. |
95035
fde6f792a832
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
7 |
fde6f792a832
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
8 # GNU Emacs is free software: you can redistribute it and/or modify |
84104 | 9 # it under the terms of the GNU General Public License as published by |
95035
fde6f792a832
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
10 # the Free Software Foundation, either version 3 of the License, or |
fde6f792a832
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
11 # (at your option) any later version. |
fde6f792a832
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
12 |
84104 | 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. | |
95035
fde6f792a832
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
17 |
84104 | 18 # You should have received a copy of the GNU General Public License |
95035
fde6f792a832
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
19 # along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
fde6f792a832
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
20 |
84104 | 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 | |
126 # arch-tag: f8460df6-6bef-4c98-8555-e2c63a88b0fa |