#!/usr/bin/perl
# $Id: Hypersrc.pl,v 1.46 2000/12/19 02:46:25 jimb Exp $
#
# Author   : Jim Brooks <jim@jimbrooks.org>
# Synopsis : Wrapper that automates "hypersrc".
# Usage    : See "Hypersrc.pl -help" and "hypersrc -help" for option list.
# Overview : 1. "find" is called to build a list of source files
#               (unless -srcs/-dirs is passed).
#            2. ctags.pl (which wraps/augments Exuberant ctags) is called
#               to produce lines of tags.
#            3. The tags lines are piped to "hypersrc".
# Notes    : This script is sed-edited by "make install".
# -----------------------------------------------------------------------------

use English;
use Cwd;
use File::Basename;

# =============================================================================
# ==== BEGIN CONFIGURATION ====================================================
#
# Generally, only the paths really need to be configured.
# The find/verbosity/temp/etc settings can be left as-is if you're in a hurry.


# Path to hypersrc/ctags.pl/Exuberant ctags (don't use ~ in Perl scripts).
# Red Hat 6.0 has Exuberant ctags at /usr/bin.
#
$hypersrc = "/usr/lib/hypersrc/hypersrc";
$ctags_pl = "/usr/lib/hypersrc/ctags.pl";
$ctags    = "/usr/bin/ctags";
#$ctags    = "/usr/local/bin/ctags-2.0.3";

# These are hypersrc args for customization.
#
# For lo-res screen:
#$argsHypersrcCustom = "-tab-width 4  -geom 80 160 940 600 -TagModuleTypeLine -column-widths 140 90 70 20  -max-tags 100000 -font-list \"6x12\"";
#
# For med-res screen:
#$argsHypersrcCustom = "-tab-width 4  -geom 24 80 1000 680 -TagModuleTypeLine -column-widths 110 70 46 20  -max-tags 100000 -font-list \"6x12\"";
#
# For hi-res screen:
#$argsHypersrcCustom = "-tab-width 4  -geom 24 100 1200 720 -TagModuleTypeLine -column-widths 140 90 56 30  -max-tags 100000 -font-list \"6x12\"";


# These are defaults args for this Hypersrc.pl itself (which are prepended before user-passed args).
#
#@argsDefault = ( "-lang", "c" );
@argsDefault = ( "-lang", "c", "-lang", "c++" );

# How many directories 'find' will descend.
#
$descend = 5;

# Verbosity.
#
$verbose = 1;

# Set a short or long window title (either based on CWD).
#
$shortWindowTitleFlag = 1;

# Last, load an optional inline Perl file in order to customize.
# The inline file could override any of the above.
#
$optional_custom_file = `cat ~/.hypersrcpl 2>/dev/null`;
eval $optional_custom_file;

# ==== END CONFIGURATION ======================================================
# =============================================================================

print "\n";

# Variables.
#
@ext                  = ( );
@extTmp               = ( );
@argsHypersrc         = ( );
$ignoreNextArg        = 0;
$buildSrcListFromArgs = 0;
$buildDirListFromArgs = 0;
$srcsOption           = 0;		# true if "-srcs" passed
$srcString            = "";		# string of lines of filenames
@srcs                 = ( );	# list   of src files
@dirs                 = ( );	# list of      dirs as passed by "-dirs" cmd arg
$ctags_pl_args        = "";
$Hypersrc_pl          = basename( $PROGRAM_NAME );
$maxItemsInTitle      = 7;

$gdb				  = 0;

# Check that the paths are correct.
#
CheckPaths();

# Merge default Hypersrc.pl args with passed args.
#
@argsMerged = ( @argsDefault, @ARGV );

# Parse args passed to Hypersrc.pl (some may be intended for hypersrc).
#
# Filter out args that only Hypersrc.pl understands
# by building a second arg list that Hypersrc.pl doesn't understand,
# which is assumed to be args for hypersrc.
#
$argIdx	= -1;
foreach ( @argsMerged )
{
   ++$argIdx;

   # Should this arg be ignored?
   #
   if ( $ignoreNextArg )
   {
      $ignoreNextArg = 0;
      next;
   }

   # Should this arg be added to the list of src files?
   #
   if ( $buildSrcListFromArgs )
   {
      # Append this arg only if it does not have a "-" prefix.
      # (such args are assumed to be more options).
      #
      if ( substr( $_, 0, 1 ) ne "-" )
      {
         # Add this arg to the list of src files.
         # Go to next arg.
         #
         $srcString = $srcString.$_."\n";
         @srcs = ( @srcs, $_ );
         if ( $argIdx ne $#argsMerged )
            { print "$_ "; }
         else
            { print "$_ \n"; }
         next;
      }

      # This arg is prefixed with "-".
      # Turn off the building of the src list.
      #
      $buildSrcListFromArgs = 0;
      print "\n";
   }

   # Should this arg be added to the list of dirs?
   #
   if ( $buildDirListFromArgs )
   {
      # Append this arg only if it does not have a "-" prefix.
      # (such args are assumed to be more options).
      #
      if ( substr( $_, 0, 1 ) ne "-" )
      {
         # Add this arg to the list of dirs.
         # Go to next arg.
         #
         @dirs = ( @dirs, "$_" );
         if ( $argIdx ne $#argsMerged )
            { print "$_ "; }
         else
            { print "$_ \n"; }
         next;
      }

      # This arg is prefixed with "-".
      # Turn off the building of the dir list.
      #
      $buildDirListFromArgs = 0;
      print "\n";
   }

   if (    $_ eq "--help"
        || $_ eq "-help"
        || $_ eq "-h" )
   {
      print( "\nHypersrc.pl is a front-end for \'hypersrc\'.                        \n" );
      print( "                                                                      \n" );
      print( "Default options:                                                      \n" );
      print( "                                                                      \n" );
      print( "   If no options are passed then Hypersrc.pl will default             \n" );
      print( "   to browsing C language source files at the current directory.      \n" );
      print( "                                                                      \n" );
      print( "Source file options:                                                  \n" );
      print( "                                                                      \n" );
      print( "   -lang  c|c++|perl|asm|m4|forth                                     \n" );
      print( "        Which programming language.                                   \n" );
      print( "        Only one language can be paired with -lang,                   \n" );
      print( "        but -lang can be specified multiple times.                    \n" );
      print( "                                                                      \n" );
      print( "   -ext  fileNameExtension                                            \n" );
      print( "        If -lang does not support a particular file extension,        \n" );
      print( "        then use this to specify it.                                  \n" );
      print( "        Only one extension can be paired with -ext,                   \n" );
      print( "        but -ext can be specified multiple times.                     \n" );
      print( "                                                                      \n" );
      print( "   -srcs  [one or more source files, separated by spaces]             \n" );
      print( "        Specify a list of source files.                               \n" );
      print( "        The script will use this list instead of calling \'find\'.    \n" );
      print( "        (Src file names must not begin with a hyphen.)                \n" );
      print( "                                                                      \n" );
      print( "   -dirs  [one or more directories, separated by spaces]              \n" );
      print( "        Specify a list of dirs in which to collect tags.              \n" );
      print( "                                                                      \n" );
      print( "Other options:                                                        \n" );
      print( "                                                                      \n" );
      print( "   -descend x                                                         \n" );
      print( "        How many subdirs to descend when finding source files.        \n" );
      print( "        (Use 2 to descend down to one subdir level.)                  \n" );
      print( "                                                                      \n" );
      print( "   -class-qual                                                        \n" );
      print( "        Fully qualify class members                                   \n" );
      print( "        (eg show 'class::member' in tag name)                         \n" );
      print( "                                                                      \n" );
      print( "hypersrc-specific options:                                            \n" );
      print( "                                                                      \n" );
      print( "   Options not handled by Hypersrc.pl will be passed thru to hypersrc.\n" );
      print( "                                                                      \n" );
      print( "Examples:                                                             \n" );
      print( "                                                                      \n" );
      print( "   Hypersrc.pl              (defaults to C src files: .c,.h)          \n" );
      print( "   Hypersrc.pl  -lang perl  (browse Perl scr files)                   \n" );
      print( "   Hypersrc.pl  -ext .C     (browse only C++ src files ending with .C)\n" );
      print( "                                                                      \n" );
      print( "Jim Brooks jim\@jimbrooks.org                                         \n" );
      print( "\n" );

      #system "${hypersrc} -help | more";

      exit 0;
   }

   if ( $_ eq "-srcs"  ||  $_ eq "-src" )
   {
      # All args that follow, without a "-" prefix,
      # are assumed to be names of source files.
      #
      # Set a flag so that the next arg iterations will build
      # a list of source files, until an arg is found with a "-" prefix.
      #
      $buildSrcListFromArgs = 1;

      # Preamble, later will print each parsed src file.
      #
      print( "Specified src files: " );

      # Set a flag (which stays set) to remember that "-srcs" was specified.
      # This flag will later cause calling "find" to be bypassed.
      #
      $srcsOption = 1;

      next;
   }

   if ( $_ eq "-dirs"  ||  $_ eq "-dir" )
   {
      # All args that follow, without a "-" prefix,
      # are assumed to be names of dirs (that contain source files).
      #
      # Set a flag so that the next arg iterations will build
      # a list of dirs, until an arg is found with a "-" prefix.
      #
      $buildDirListFromArgs = 1;

      # Preamble, later will print each parsed dir.
      #
      print( "Specified dirs: " );

      next;
   }

   if ( $_ eq "-descend"  ||  $_ eq "-maxdepth" )
   {
      $descend = $argsMerged[$argIdx+1];

      $ignoreNextArg = 1;
      next;
   }

   if ( $_ eq "-class-qual" )
   {
      # This arg will be passed to, and handled by, ctags.pl.
      #
      $ctags_pl_args = " -class-qual ";
      next;
   }

   if ( $_ eq "-ext" )
   {
      # The arg after "-ext" is assumed to be a file extension.
      #
      Msg( "Will tag file extension \'$argsMerged[$argIdx+1]\'.\n" );
      @extTmp = ( @extTmp, $argsMerged[$argIdx+1] );

      $ignoreNextArg = 1;
      next;
   }

   if ( $_ eq "-lang"  &&  $argsMerged[$argIdx+1] eq "c" )
   {
      Msg( "Will tag C language (.c/.h) source files.\n" );
      @extTmp = ( @extTmp, ".c" );
      @extTmp = ( @extTmp, ".h" );

      $ignoreNextArg = 1;
      next;
   }

   if ( $_ eq "-lang"  &&  $argsMerged[$argIdx+1] eq "c++" )
   {
      Msg( "Will tag C++ language source files.\n" );
      @extTmp = ( @extTmp, ".cc" );
      @extTmp = ( @extTmp, ".cxx" );
      @extTmp = ( @extTmp, ".cpp" );	# a dumb ext for C++ src
      @extTmp = ( @extTmp, ".C" );		# another dumb one
      @extTmp = ( @extTmp, ".h" );
      @extTmp = ( @extTmp, ".hh" );
      @extTmp = ( @extTmp, ".hxx" );
      @extTmp = ( @extTmp, ".inl" );	# inline functions (specific to C++ ?)

      $ignoreNextArg = 1;
      next;
   }

   if ( $_ eq "-lang"  &&  $argsMerged[$argIdx+1] eq "asm" )
   {
      Msg( "Will tag assembly language (.s/.S/.sm4/.asm/.inc) source files.\n" );
      @extTmp = ( @extTmp, ".s" );
      @extTmp = ( @extTmp, ".S" );		# asm file that needs cpp preprocessing
      @extTmp = ( @extTmp, ".sm4" );	# asm file that needs M4 preprocesing
      @extTmp = ( @extTmp, ".asm" );
      @extTmp = ( @extTmp, ".inc" );

      $ignoreNextArg = 1;
      next;
   }

   if ( $_ eq "-lang"  &&  $argsMerged[$argIdx+1] eq "perl" )
   {
      Msg( "Will tag Perl script (.pl) source files.\n" );
      @extTmp = ( @extTmp, ".pl" );

      $ignoreNextArg = 1;
      next;
   }

   if ( $_ eq "-lang"  &&  $argsMerged[$argIdx+1] eq "forth" )
   {
      Msg( "Will tag FORTH language (.4th/.fth/.blk) source files.\n" );
      @extTmp = ( @extTmp, ".4th" );
      @extTmp = ( @extTmp, ".fth" );
      @extTmp = ( @extTmp, ".blk" );

      $ignoreNextArg = 1;
      next;
   }

   if ( $_ eq "-lang"  &&  $argsMerged[$argIdx+1] eq "m4" )
   {
      Msg( "Will tag M4 macro (.m4) source files.\n" );
      @extTmp = ( @extTmp, ".m4" );

      $ignoreNextArg = 1;
      next;
   }

   if ( $_ eq "-gdb" )
   {
      $gdb = 1;
      next;
   }

   # This arg is not understood by Hypersrc.pl.
   # Add it to the arg list that is assumed to be for hypersrc.
   #
   @argsHypersrc = ( @argsHypersrc, $_ );
}

# Default to CWD if no dirs were specified.
#
$_ = @dirs;
if ( $_ eq 0 )
{ @dirs = ( "." ); }

# Ensure that no file extension is duplicated.
# Output will be in @ext.
#
FilterDupFileExt();

# If no file extensions were specified, then default to C src files.
#
$extLen = @ext;
unless ( $extLen )
{
   Msg( "Defaulting to C source files.\n" );
   @ext = ( ".c", ".h" );
}

# Show what file extensions will be tagged.
#
Msg( "Source file extensions to tag are: @ext\n" );

# Build a list of source files if "-srcs" wasn't specified.
# Removing the leading "./" that is prepended by "find".
# Exclude "RCS/".
#
if ( ! $srcsOption )
{
   Msg( "Building a list of source files (patience)...\n" );
   foreach $item (@ext)
   {
      foreach $dir (@dirs)
      {
         # Invoke "find" to print each filename on a separate line,
         # so that ctags.pl can subsequently read filenames by line via stdin.
         #
         $srcString = $srcString.`find $dir -maxdepth ${descend} -name "*$item" -printf "\\"%p\\"\n"  `;
      }
   }
   $srcString =~ s/\.\///g;
   $srcString =~ s/\bRCS.*\b//;
}

# Ensure the list of source files is not empty.
#
if ( $srcString eq "" )
{
   print( "## No source files were found nor specified, quitting. \n" );
   exit 1;
}

# Title the window based on CWD or specified dirs.
#
$dirCnt = @dirs;
if ( $dirCnt == 1  &&  $dirs[0] eq "." )
{
   if ( ! $srcsOption )
   {
      if ( $shortWindowTitleFlag )
         { $title = basename( cwd() ); }
      else
         { $title = cwd(); }
   }
   else
   {
      BuildTitleFromList( "srcs" );
   }
}
else
{
   # Dirs were specified.  Truncate titles if multiple dirs.
   #
   BuildTitleFromList( "dirs" );
}

###################
# Debug: dump ctags output to a file
#
if ( 0 )
{
   Msg( "DEBUG: dumping tags to /tmp/tags.tmp \n" );
   open( PIPE, "| ${ctags_pl}  -stdin  ${ctags_pl_args}  -ctags-path ${ctags}  -enable-non-tag  > /tmp/tags.tmp" );
   print PIPE "$srcString";
   close( PIPE );
   exit 0;
}
###################

########################
# Run hypersrc under gdb
if ( $gdb )
{
   # Create gdb command file (for hypersrc args).
   #
   $cmdFile = "/tmp/hypersrc_gdb_${PID}.tmp";
   open( CMD_FILE, ">$cmdFile" );
   print CMD_FILE "run -stdin ${argsHypersrcCustom} @argsHypersrc -title 'hypersrc (${title})' \n";
   print CMD_FILE "q \n";
   close( CMD_FILE );

   Msg( "Piping ctags into hypersrc... \n" );
   open( PIPE, "| ${ctags_pl}  -stdin  ${ctags_pl_args}  -ctags-path ${ctags}  -enable-non-tag  |  gdb -x $cmdFile ${hypersrc} " );
   print PIPE "$srcString";
   close( PIPE );

   system "rm -f $cmdFile";

   exit 0;
}
########################

# Start the pipeline.
# Begin by piping the list of filenames to ctags.pl.
# (Piping is necessary because list might be too long to be passed via cmd-line).
#
Msg( "Piping ctags into hypersrc... \n" );
open( PIPE, "| ${ctags_pl}  -stdin  ${ctags_pl_args}  -ctags-path ${ctags}  -enable-non-tag  |  ${hypersrc} -stdin ${argsHypersrcCustom} @argsHypersrc -title 'hypersrc (${title})'" );
print PIPE "$srcString";
close( PIPE );

# Done.
#
exit 0;

# =============================================================================
# subroutines
# =============================================================================

sub Msg
{
   # Only print a message if $verbose.
   #
   if ( $verbose )
   {
      print "$_[0]";
   }
}

sub IsHypersrcExecutable
{
   # Return true if $hypersrc points to an executable binary.
   # Ignore hypersrc dir (dirs are also executable).
   #
   stat( "$hypersrc" );
   if ( -x _  &&  ! -d _ ) { return 1; }
   return 0;
}

sub TestInvokingHypersrc
{
   # Return true if hypersrc can be invoked.
   #
   $_ = `$hypersrc -h`;
   return defined($_)  &&  ($_ ne "");
}

sub FilterDupFileExt
{
   # @extTmp holds the original file extensions.
   # @ext    is the output which holds only unique file extensions.

   %seen = ();
   @ext  = ();
   foreach $item (@extTmp)
   {
      unless ($seen{$item})
      {
         # Never seen before.
         #
         $seen{$item} = 1;
         push(@ext, $item);
      }
   }
}

sub CheckPaths
{
   # Ensure $hypersrc points to an executable.
   # If not, try to correct $hypersrc.
   #
   if ( ! IsHypersrcExecutable() )
   {
#      print( "## Configured path to hypersrc is wrong, defaulting to PATH. \n" );

      # Remember original paths.
      #
      $hypersrc_orig = $hypersrc;
      $ctags_pl_orig = $ctags_pl;

      # Try to locate hypersrc using PATH.
      #
      $hypersrc  =  "hypersrc";		# <-- extra spaces to fool Makefile install

      if ( ! IsHypersrcExecutable() )
      {
         # Perhaps Hypersrc.pl was invoked after "make install" was done?
         #
         $hypersrc = $Hypersrc_pl;
         $hypersrc =~ s/${Hypersrc_pl}/hypersrc/;

         $ctags_pl = $Hypersrc_pl;
         $ctags_pl =~ s/${Hypersrc_pl}/ctags.pl/;
      }
      if ( ! IsHypersrcExecutable() )
      {
         # Perhaps Hypersrc.pl was invoked without "make install"?
         #
         $hypersrc = $Hypersrc_pl;
         $hypersrc =~ s/${Hypersrc_pl}/out\/hypersrc/;

         $ctags_pl = $Hypersrc_pl;
         $ctags_pl =~ s/${Hypersrc_pl}/ctags.pl/;
      }
      if ( ! IsHypersrcExecutable() )
      {
         # Perhaps Hypersrc.pl is a symlink?
         #
         $hypersrc = readlink "$PROGRAM_NAME";
         chomp $hypersrc;
         $hypersrc =~ s/${Hypersrc_pl}/out\/hypersrc/;

         $ctags_pl = readlink "$PROGRAM_NAME";
         chomp $ctags_pl;
         $ctags_pl =~ s/${Hypersrc_pl}/ctags.pl/;
      }
      if ( ! IsHypersrcExecutable() )
      {
         # Ugghhh, the programs appear to not be executable and/or outside PATH.
         # Charge forward with invocation test, in case this Perl code here is mistaken.
         #
         #print( "## This script\'s paths seem misconfigured, proceeding anyway... ##\n" );
         $hypersrc = $hypersrc_orig;
         $ctags_pl = $ctags_pl_orig;
      }
   }

   # Ensure hypersrc can be invoked.
   #
   if ( ! TestInvokingHypersrc() )
   {
      print( "## Failed to invoke hypersrc. \n" );
      print( "## Try configuring this script. \n" );
      exit 1;
   }

   # Ensure there is a recent version of Exuberant ctags.
   #
   $_ = `$ctags --version 2>/dev/null | grep Hiebert`;
   if ( "" eq $_  ||  ! defined($_) )
   {
      # Perhaps this is not Red Hat 6.0 but Exuberant ctags is at /usr/local/bin?
      #
      $ctags ="/usr/local/bin/ctags";
   }
   $_ = `$ctags --version 2>/dev/null | grep Hiebert`;
   if ( "" eq $_  ||  ! defined($_) )
   {
      print( "## Script could not find a recent version of Exuberant ctags.\n" );
      print( "## Try configuring this script.\n" );
      print( "## Exuberant ctags is available at http://fly.hiwaay.net/~darren/ctags \n" );
      print( "## or as a package of Red Hat 6.0.                                     \n" );
      exit 1;
   }
}

# Parms: $1 = "dirs" or "srcs"
#
sub BuildTitleFromList
{
   my $dirs_or_srcs = $_[0];

   if    ( "$dirs_or_srcs" eq "dirs" )
   {
      $title = "dirs: ";
      @list = @dirs;
   }
   elsif ( "$dirs_or_srcs" eq "srcs" )
   {
      $title = "srcs: ";
      @list = @srcs;
   }
   else
   { die; }

   my $cnt = @list;

   # Truncate titles if multiple dirs.
   #
   for ( 0 .. $maxItemsInTitle-1 )
   {
      if ( $_ eq $cnt ) { last; }

      if ( $shortWindowTitleFlag )
      {
         # basename will be confused by a superfluous trailing "/".
         #
         $item = $list[$_];
         if ( substr( $item, length($item)-1, 1 ) eq "/" )
         { chop $item; }

         if ( $_ gt 0 ) { $title = $title . ", "; }
         $title = $title . basename( $item );
      }
      else
      {
         $title = "${srcs_or_dirs}: $list[0], [...]";
         last;
      }
   }
   if ( $cnt > $maxItemsInTitle ) { $title = $title . ", [...]"; }
}
