share/vim/vim58/tools/pltags.pl

   1 #!/usr/bin/env perl
   2
   3 # pltags - create a tags file for Perl code, for use by vi(m)
   4 #
   5 # Distributed with Vim <http://www.vim.org/>, latest version always available
   6 # at <http://www.mscha.com/cgi-bin/page/mscha.html?pltags#tools>
   7 #
   8 # Version 2.1, 24 June 2000
   9 #
  10 # Written by Michael Schaap <mscha@mscha.com>.  Suggestions for improvement
  11 # are very welcome!
  12 #
  13 # This script will not work with Perl 4 or below!
  14 #
  15 # Revision history:
  16 #  1.0  1997?     Original version, quickly hacked together
  17 #  2.0  1999?     Completely rewritten, better structured and documented,
  18 #                 support for variables, packages, Exuberant Ctags extensions
  19 #  2.1  Jun 2000  Fixed critical bug (typo in comment) ;-)
  20 #                 Support multiple level packages (e.g. Archive::Zip::Member)
  21
  22 # Complain about undeclared variables
  23 use strict;
  24
  25 # Used modules
  26 use Getopt::Long;
  27
  28 # Options with their defaults
  29 my $do_subs = 1;    # --subs, --nosubs    include subs in tags file?
  30 my $do_vars = 1;    # --vars, --novars    include variables in tags file?
  31 my $do_pkgs = 1;    # --pkgs, --nopkgs    include packages in tags file?
  32 my $do_exts = 1;    # --extensions, --noextensions
  33                     #                     include Exuberant Ctags extensions
  34
  35 # Global variables
  36 my $VERSION = "2.1";    # pltags version
  37 my $status = 0;         # GetOptions return value
  38 my $file = "";          # File being processed
  39 my @tags = ();          # List of produced tags
  40 my $is_pkg = 0;         # Are we tagging a package?
  41 my $has_subs = 0;       # Has this file any subs yet?
  42 my $package_name = "";  # Name of current package
  43 my $var_continues = 0;  # Variable declaration continues on last line
  44 my $line = "";          # Current line in file
  45 my $stmt = "";          # Current Perl statement
  46 my @vars = ();          # List of variables in declaration
  47 my $var = "";           # Variable in declaration
  48 my $tagline = "";       # Tag file line
  49
  50 # Create a tag file line and push it on the list of found tags
  51 sub MakeTag($$$$$)
  52 {
  53     my ($tag,           # Tag name
  54         $type,          # Type of tag
  55         $is_static,     # Is this a static tag?
  56         $file,          # File in which tag appears
  57         $line) = @_;    # Line in which tag appears
  58
  59     my $tagline = "";   # Created tag line
  60
  61     # Only process tag if not empty
  62     if ($tag)
  63     {
  64         # Get rid of \n, and escape / and \ in line
  65         chomp $line;
  66         $line =~ s/\\/\\\\/g;
  67         $line =~ s/\//\\\//g;
  68
  69         # Create a tag line
  70         $tagline = "$tag\t$file\t/^$line\$/";
  71
  72         # If we're told to do so, add extensions
  73         if ($do_exts)
  74         {
  75             $tagline .= ";\"\t$type"
  76                             . ($is_static ? "\tfile:" : "")
  77                             . ($package_name ? "\tclass:$package_name" : "");
  78         }
  79
  80         # Push it on the stack
  81         push (@tags, $tagline);
  82     }
  83 }
  84
  85 # Parse package name from statement
  86 sub PackageName($)
  87 {
  88     my ($stmt) = @_;    # Statement
  89
  90     # Look for the argument to "package".  Return it if found, else return ""
  91     if ($stmt =~ /^package\s+([\w:]+)/)
  92     {
  93         my $pkgname = $1;
  94
  95         # Remove any parent package name(s)
  96         $pkgname =~ s/.*://;
  97         return $pkgname;
  98     }
  99     else
 100     {
 101         return "";
 102     }
 103 }
 104
 105 # Parse sub name from statement
 106 sub SubName($)
 107 {
 108     my ($stmt) = @_;    # Statement
 109
 110     # Look for the argument to "sub".  Return it if found, else return ""
 111     if ($stmt =~ /^sub\s+([\w:]+)/)
 112     {
 113         my $subname = $1;
 114
 115         # Remove any parent package name(s)
 116         $subname =~ s/.*://;
 117         return $subname;
 118     }
 119     else
 120     {
 121         return "";
 122     }
 123 }
 124
 125 # Parse all variable names from statement
 126 sub VarNames($)
 127 {
 128     my ($stmt) = @_;
 129
 130     # Remove my or local from statement, if present
 131     $stmt =~ s/^(my|local)\s+//;
 132
 133     # Remove any assignment piece
 134     $stmt =~ s/\s*=.*//;
 135
 136     # Now find all variable names, i.e. "words" preceded by $, @ or %
 137     @vars = ($stmt =~ /[\$\@\%]([\w:]+)\b/g);
 138
 139     # Remove any parent package name(s)
 140     map(s/.*://, @vars);
 141
 142     return (@vars);
 143 }
 144
 145 ############### Start ###############
 146
 147 print "\npltags $VERSION by Michael Schaap <mscha\@mscha.com>\n\n";
 148
 149 # Get options
 150 $status = GetOptions("subs!" => \$do_subs,
 151                      "vars!" => \$do_vars,
 152                      "pkgs!" => \$do_pkgs,
 153                      "extensions!" => \$do_exts);
 154
 155 # Usage if error in options or no arguments given
 156 unless ($status && @ARGV)
 157 {
 158     print "\n" unless ($status);
 159     print "  Usage: $0 [options] filename ...\n\n";
 160     print "  Where options can be:\n";
 161     print "    --subs (--nosubs)     (don't) include sub declarations in tag file\n";
 162     print "    --vars (--novars)     (don't) include variable declarations in tag file\n";
 163     print "    --pkgs (--nopkgs)     (don't) include package declarations in tag file\n";
 164     print "    --extensions (--noextensions)\n";
 165     print "                          (don't) include Exuberant Ctags / Vim style\n";
 166     print "                          extensions in tag file\n\n";
 167     print "  Default options: ";
 168     print ($do_subs ? "--subs " : "--nosubs ");
 169     print ($do_vars ? "--vars " : "--novars ");
 170     print ($do_pkgs ? "--pkgs " : "--nopkgs ");
 171     print ($do_exts ? "--extensions\n\n" : "--noextensions\n\n");
 172     print "  Example: $0 *.pl *.pm ../shared/*.pm\n\n";
 173     exit;
 174 }
 175
 176 # Loop through files on command line
 177 foreach $file (@ARGV)
 178 {
 179     # Skip if this is not a file we can open.  Also skip tags files and backup
 180     # files
 181     next unless ((-f $file) && (-r $file) && ($file !~ /tags$/)
 182                  && ($file !~ /~$/));
 183
 184     print "Tagging file $file...\n";
 185
 186     $is_pkg = 0;
 187     $has_subs = 0;
 188     $var_continues = 0;
 189
 190     open (IN, $file) or die "Can't open file '$file': $!";
 191
 192     # Loop through file
 193     foreach $line (<IN>)
 194     {
 195         # Statement is line with comments and whitespace trimmed
 196         ($stmt = $line) =~ s/#.*//;
 197         $stmt =~ s/^\s*//;
 198         $stmt =~ s/\s*$//;
 199
 200         # Nothing left? Never mind.
 201         next unless ($stmt);
 202
 203         # This is a variable declaration if one was started on the previous
 204         # line, or if this line starts with my or local
 205         if ($var_continues or ($stmt =~/^my\b/) or ($stmt =~/local\b/))
 206         {
 207             # The declaration continues if the line does not end with ;
 208             $var_continues = ($stmt !~ /;$/);
 209
 210             # Loop through all variable names in the declaration
 211             foreach $var (VarNames($stmt))
 212             {
 213                 # Make a tag for this variable unless we're told not to.  We
 214                 # assume that a variable is always static, unless it appears
 215                 # in a package before any sub.  (Not necessarily true, but
 216                 # it's ok for most purposes and Vim works fine even if it is
 217                 # incorrect)
 218                 if ($do_vars)
 219                 {
 220                     MakeTag($var, "v", (!$is_pkg or $has_subs), $file, $line);
 221                 }
 222             }
 223         }
 224
 225         # This is a package declaration if the line starts with package
 226         elsif ($stmt =~/^package\b/)
 227         {
 228             # Get name of the package
 229             $package_name = PackageName($stmt);
 230
 231             if ($package_name)
 232             {
 233                 # Remember that we're doing a package
 234                 $is_pkg = 1;
 235
 236                 # Make a tag for this package unless we're told not to.  A
 237                 # package is never static.
 238                 if ($do_pkgs)
 239                 {
 240                     MakeTag($package_name, "p", 0, $file, $line);
 241                 }
 242             }
 243         }
 244
 245         # This is a sub declaration if the line starts with sub
 246         elsif ($stmt =~/^sub\b/)
 247         {
 248             # Remember that this file has subs
 249             $has_subs = 1;
 250
 251             # Make a tag for this sub unless we're told not to.  We assume
 252             # that a sub is static, unless it appears in a package.  (Not
 253             # necessarily true, but it's ok for most purposes and Vim works
 254             # fine even if it is incorrect)
 255             if ($do_subs)
 256             {
 257                 MakeTag(SubName($stmt), "s", (!$is_pkg), $file, $line);
 258             }
 259         }
 260     }
 261     close (IN);
 262 }
 263
 264 # Do we have any tags?  If so, write them to the tags file
 265 if (@tags)
 266 {
 267     # Add some tag file extensions if we're told to
 268     if ($do_exts)
 269     {
 270         push (@tags, "!_TAG_FILE_FORMAT\t2\t/extended format/");
 271         push (@tags, "!_TAG_FILE_SORTED\t1\t/0=unsorted, 1=sorted/");
 272         push (@tags, "!_TAG_PROGRAM_AUTHOR\tMichael Schaap\t/mscha\@mscha.com/");
 273         push (@tags, "!_TAG_PROGRAM_NAME\tpltags\t//");
 274         push (@tags, "!_TAG_PROGRAM_VERSION\t$VERSION\t/supports multiple tags and extended format/");
 275     }
 276
 277     print "\nWriting tags file.\n";
 278
 279     open (OUT, ">tags") or die "Can't open tags file: $!";
 280
 281     foreach $tagline (sort @tags)
 282     {
 283         print OUT "$tagline\n";
 284     }
 285
 286     close (OUT);
 287 }
 288 else
 289 {
 290     print "\nNo tags found.\n";
 291 }