#!/usr/bin/perl
# $Id: ctags.pl,v 1.17 2001/02/18 05:46:04 jimb Exp $
#
# Author   : Jim Brooks <jim@jimbrooks.org>
# Synopsis : This script is a supplement for Exuberant ctags.
#            This script will itself process some source files
#            that Exuberant ctags does not support.
#            All other source files that are not processed
#            by this script will be deferred to Exuberant ctags.
# Args     : Mandatory arg is "-ctags-path" (though defaults to PATH).
#            Any other args should be names of one or more source files.
#
#            -stdin
#            stdin is assumed to be a list of filenames.
#            Each filename must be on its own line.
#          
# Output   : Produces output (to stdout) in Exuberant ctags -x format.
# Notes    : This script does not sort the output (because hypersrc will).
#            Must handle passed quoted filenames.
# --------------------------------------------------------------------------

# Vars.
#
$debug        = 0;
$ctags        = "";					# DO NOT DEFAULT THIS AS "ctags" (might be GNU ctags)
$ctags_args   = "-x";      # default ctags args
$enableNonTag = 0;

#---------------------------------------------------------------------------
# Main loop.
#---------------------------------------------------------------------------

# Pass #1 of arg parse collects file list from stdin (if -stdin is an arg).
# Hypersrc.pl must pass the file list via stdin, not via cmd-line,
# because evidently UNIX (Linux) limits the amount of cmd-line args.
#
@files = ( );
@ARGV_copy = ( @ARGV );		# shift will empty ARGV

while ( $arg = shift(@ARGV) )
{
   # Is this "-stdin"?
   #
   if ( $arg eq "-stdin" )
   {
      # Each line of stdin is expected to be a filename.
      # Build a list to hold each line of stdin.
      #
      while (<STDIN>)
      {
         chomp($_);
         @files = ( @files, "$_" );
      }
      last;
   }
}

# Append file list to cmd-line args.
#
@args = ( @ARGV_copy, @files );

# Pass #2 of arg parse.
#
while ( $arg = shift(@args) )
{
   # For speed, first recognize common cases.
   #
   if (    index( $arg, ".c" )  >= 0
        || index( $arg, ".h" )  >= 0 
        || index( $arg, ".cc" ) >= 0 )
   {
      goto call_ctags;
   }

   # Is this the debug option?
   #
   if ( $arg eq "-debug" )
   {
      $debug = 1;
      next;
   }

   # Is this "-stdin"?
   #
   if ( $arg eq "-stdin" )
   {
      # Ignore -stdin this time.
      #
      next;
   }

   # Is this "-ctags-path"?
   #
   if ( $arg eq "-ctags-path" )
   {
      $ctags = shift(@args);
      next;
   }

   # Is this "-enable-non-tag"?
   #
   # When enabled, and a source file could not be tagged,
   # this script will still output a dummy tag.
   #
   if ( $arg eq "-enable-non-tag" )
   {
      $enableNonTag = 1;
      next;
   }

   # Is this the qualify class members option?
   #
   if ( $arg eq "-class-qual" )
   {
      # Append ctags arg.
      #
      $ctags_args = "$ctags_args" . " --c-types=+C ";
      next;
   }

   # Is this -proto?
   #
   if ( $arg eq "-proto" )
   {
      # Append ctags arg.
      #
      $ctags_args = "$ctags_args" . " --c-types=+p ";
      next;
   }

   # Is this an assembly file?
   #
   if (    index( $arg, ".s"   ) >= 0
        || index( $arg, ".S"   ) >= 0
        || index( $arg, ".sm4" ) >= 0
        || index( $arg, ".asm" ) >= 0 )
   {
      Msg( "$arg will be processed as assembly. \n" );
      TagsAsm( $arg );
      next;
   }

   # Is this a M4 macro file?
   #
   if ( index( $arg, ".m4" ) >= 0 )
   {
      Msg( "$arg will be processed as M4. \n" );
      TagsM4( $arg );
      next;
   }

   # This arg wasn't recognized.
   # Try to distinguish an incorrect arg between a source file.
   # TODO

   # This arg, assumed to be a source file, wasn't recognized.
   # Defer to Exuberant ctags.
   #
call_ctags:
   if ( $ctags eq "" ) { print( "## First pass -ctags-path. \n"); die; }
   $ctagsOutput = `${ctags} ${ctags_args} ""${arg}""`;
   if ( "$ctagsOutput" ne "" )
   {
      print( "$ctagsOutput" );
      next;
   }
   else
   {
      # This source file wasn't tagged at all.
      # If "-enable-non-tag" was specified, create a bogus ctags -x line
      # so that hypersrc will at least be able to load/show the src file.
      #
      if ( substr( $arg, 0, 1 ) ne "\"" )
      { $noquotes = $arg; }
      else
      { $noquotes = substr( $arg, 1, length($arg)-2 ); }

      if ( $enableNonTag ) { print( "(NONE) (NONE) 1 ${noquotes} (NONE)\n" ); }
      next;
   }
}

# Script is done.
#
exit 0;

#---------------------------------------------------------------------------
# Produce ctags -x output from an assembly file.
#
# Parms   : [0]
#           Pathname of assembly file (eg .s/.S/.asm).
#---------------------------------------------------------------------------
sub TagsAsm
{
   my $file = $_[0];
   $file 	= Dequote( $file );
   $line	= 1;

   # Open the file.
   #
   open( FILE, "$file" );

   # Read each line to look for "label:"
   #
   while ( <FILE> )
   {
      # Is this line "label:"?
      #
      if ( /^[a-zA-Z0-9_]*:/ )
      {
         # Print a pseudo ctags -x line.
         #
         # '$&' contains the match of the above regex.
         #
         PrintCtagsLine( substr($&, 0, length($&)-1 ),  # skip trailing ":"
                         "label",
                         $line,
                         $file,
                         "''" );
      }

      # Count this line.
      #
      ++$line;
   }

   # Close the file.
   #
   close( FILE );
}

#---------------------------------------------------------------------------
# Produce ctags -x output from a M4 macro file.
#
# Parms   : [0]
#           Pathname of M4 macro file.
#---------------------------------------------------------------------------
sub TagsM4
{
   my $file = $_[0];
   $file 	= Dequote( $file );
   $line	= 1;

   # Open the file.
   #
   open( FILE, "$file" );

   # Read each line to look for "define(macroname"
   #
   while ( <FILE> )
   {
      # Is this line "define(macroname"?
      #
      if ( /^define\([a-zA-Z0-9_]*\,/ )
      {
         # Print a pseudo ctags -x line.
         #
         # '$&' contains the match of the above regex.
         #
         $tag = $&;
         $tag =~ s/define\(//;
         $tag =~ s/,//;
         PrintCtagsLine( $tag,
                         "m4_macro",
                         $line,
                         $file,
                         "''" );
      }

      # Is this line "label:"?
      #
      if ( /^[a-zA-Z0-9_]*:/ )
      {
         # Print a pseudo ctags -x line.
         #
         # '$&' contains the match of the above regex.
         #
         PrintCtagsLine( substr($&, 0, length($&)-1 ),  # skip trailing ":"
                         "label",
                         $line,
                         $file,
                         "''" );
      }

      # Count this line.
      #
      ++$line;
   }

   # Close the file.
   #
   close( FILE );
}

#---------------------------------------------------------------------------
# Print a ctags -x line.
#
# Parms   : [0]
#           Tag.
#
#         : [1]
#           The type of the tag.
#
#         : [2]
#           Line.
#
#         : [3]
#           File.
#
#         : [4]
#           Extraneous text that ctags -x prints as the last field.
#---------------------------------------------------------------------------
sub PrintCtagsLine
{
#   print "$_[0]   $_[1]   $_[2]   $_[3]   $_[4]\n";
    print "$_[0] \t\t $_[1] \t $_[2] \t $_[3] \t $_[4]\n";
}

# =============================================================================
# Misc subroutines
# =============================================================================
sub Msg
{
   # Only print a message if $debug.
   #
   if ( $debug )
   {
      print "\n\#\# $_[0]\n";
   }
}

# =============================================================================
# Remove any bounding quotes.
# =============================================================================
sub Dequote
{
   my $str = $_[0];

   # Only print a message if $debug.
   #
   if (    substr( $str, 0,              1 ) eq "\""
        && substr( $str, length($str)-1, 1 ) eq "\"" )
   {
      return substr( $str, 1, length($str)-2 );
   }

   return $str;
}