diff options
| author | Gerd Moellmann | 2000-01-05 14:29:52 +0000 |
|---|---|---|
| committer | Gerd Moellmann | 2000-01-05 14:29:52 +0000 |
| commit | dfc16043b155d13d8ae562dcc268e4b73b1f59f1 (patch) | |
| tree | 19c5dd0f2eb4dd07c453f67fb1e7cff8558482c6 | |
| parent | 176c9de4b4366110131c6d5fc1cc812d706c41fa (diff) | |
| download | emacs-dfc16043b155d13d8ae562dcc268e4b73b1f59f1.tar.gz emacs-dfc16043b155d13d8ae562dcc268e4b73b1f59f1.zip | |
*** empty log message ***
| -rw-r--r-- | lispref/ChangeLog | 4 | ||||
| -rwxr-xr-x | lispref/tindex.pl | 125 |
2 files changed, 129 insertions, 0 deletions
diff --git a/lispref/ChangeLog b/lispref/ChangeLog index a0b19b89087..44dcbe5ffb7 100644 --- a/lispref/ChangeLog +++ b/lispref/ChangeLog | |||
| @@ -1,3 +1,7 @@ | |||
| 1 | 2000-01-05 Gerd Moellmann <gerd@gnu.org> | ||
| 2 | |||
| 3 | * tindex.pl: New script. | ||
| 4 | |||
| 1 | 1999-12-03 Dave Love <fx@gnu.org> | 5 | 1999-12-03 Dave Love <fx@gnu.org> |
| 2 | 6 | ||
| 3 | * Makefile.in (MAKEINFO): New parameter. | 7 | * Makefile.in (MAKEINFO): New parameter. |
diff --git a/lispref/tindex.pl b/lispref/tindex.pl new file mode 100755 index 00000000000..c138f5d66f1 --- /dev/null +++ b/lispref/tindex.pl | |||
| @@ -0,0 +1,125 @@ | |||
| 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 | |||