This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: XS-assisted SWASHGET (esp. for t/uni/class.t speedup)
[perl5.git] / emacs / e2ctags.pl
1
2 ##e2ctags.pl
3 ##Convert an Emacs-style TAGS file to a standard ctags file.
4 ##Runs in a single pass over the TAGS file and keeps the first
5 ##tag entry found, and the file name and line number the tag can
6 ##be found on.
7 ##Then it opens all relevant files and builds the regular expression
8 ##for ctags.
9 ##Run over a few test files and compared with a real ctags file shows
10 ##only extra tags in the translated file, which probably won't hurt
11 ##vi.
12 ##
13
14 use strict;
15
16 my $filename;
17 my ($tag,$line_no,$line);
18 my %tags = ();
19 my %filetags = ();
20 my %files = ();
21 my @lines = ();
22
23 while (<>) {
24   if ($_ eq "\x0C\n") {
25     ##Grab next line and parse it for the filename
26     $_ = <>;
27     chomp;
28     s/,\d+$//;
29     $filename = $_;
30     ++$files{$filename};
31     next;
32   }
33   ##Figure out how many records in this line and
34   ##extract the tag name and the line that it is found on
35   next if /struct/;
36   if (/\x01/) {
37     ($tag,$line_no) = /\x7F(\w+)\x01(\d+)/;
38   }
39   else {
40     tr/(//d;
41     ($tag,$line_no) = /(\w+)\s*\x7F(\d+),/;
42   }
43   next unless $tag;
44   ##Take only the first entry per tag
45   next if defined($tags{$tag});
46   $tags{$tag}{FILE} = $filename;
47   $tags{$tag}{LINE_NO} = $line_no;
48   push @{$filetags{$filename}}, $tag;
49 }
50
51 foreach $filename (keys %files) {
52   open FILE, $filename or die "Couldn't open $filename: $!\n";
53   @lines = <FILE>;
54   close FILE;
55   chomp @lines;
56   foreach $tag ( @{$filetags{$filename}} ) {
57     $line = $lines[$tags{$tag}{LINE_NO}-1];
58     if (length($line) >= 50) {
59       $line = substr($line,0,50);
60     }
61     else {
62       $line .= '$';
63     }
64     $line =~ s#\\#\\\\#;
65     $tags{$tag}{LINE} = join '', '/^',$line,'/';
66   }
67 }
68
69 foreach $tag ( sort keys %tags ) {
70   print "$tag\t$tags{$tag}{FILE}\t$tags{$tag}{LINE}\n";
71 }