use Getopt::Std;
sub usage
{
print <<_EOUSAGE_ ;
USAGE: $program [-kvwVx] [-t <file>] <files>
-t <file> Name of tags file to create. (default is 'tags')
-s <shell> Name of the shell language in the script
-v Include variable definitions.
(variables mentioned at the start of a line)
-V Print version information.
-w Suppress "duplicate tag" warnings.
-x Explicitly create a new tags file. Normally tags are merged.
<files> List of files to scan for tags.
_EOUSAGE_
exit 0
}
sub version
{
@id = split( ', ', 'scripts/bin/shtags, /usr/local/, LOCAL_SCRIPTS, 1.2, 18/04/02, 07:37' );
$id[0] =~ s,.*/,,;
print <<_EOVERS;
$id[0]: $id[3]
Last Modified: @id[4,5]
Component: $id[1]
Release: $id[2]
_EOVERS
exit( 1 );
}
($program = $0) =~ s,.*/,,;
getopts( "t:s:vVwx" ) || &usage();
$tags_file = $opt_t || 'tags';
$explicit = $opt_x;
$variable_tags = $opt_v;
$allow_warnings = ! $opt_w;
&version if $opt_V;
&usage() unless @ARGV != 0;
if( ! $explicit && open( TAGS, "< $tags_file" ) )
{
while( <TAGS> )
{
/^\S+/;
$tags{$&} = $_;
}
close( TAGS );
}
while( <> )
{
&check_shell($_), ( $old_file = $ARGV ) if $ARGV ne $old_file;
next unless $shell;
if( $shell eq "sh" )
{
next unless /^\s*(((\w+)))\s*\(\s*\)/
|| ( $variable_tags && /^(((\w+)=))/ );
$match = $3;
}
if( $shell eq "ksh" )
{
next unless /^\s*function\s+(((\w+)))/
|| ( $variable_tags && /^(((\w+)=))/ );
$match = $3;
}
if( $shell eq "perl" )
{
next unless /^\s*sub\s+(\w+('|::))?(\w+)/
|| /^\s*(((\w+))):/
|| ( $variable_tags && /^(([(\s]*[\$\@\%]{1}(\w+).*=))/ );
$match = $3;
}
if( $shell eq "tcl" )
{
next unless /^\s*proc\s+(((\S+)))/
|| ( $variable_tags && /^\s*set\s+(((\w+)\s))/ );
$match = $3;
}
chop;
warn "$match - duplicate ignored\n"
if ( $new{$match}++
|| !( $tags{$match} = sprintf( "%s\t%s\t?^%s\$?\n", $match, $ARGV, $_ ) ) )
&& $allow_warnings;
}
# write the new tags to the tags file - note that the whole file is rewritten
open( TAGS, "> $tags_file" );
foreach( sort( keys %tags ) )
{
print TAGS "$tags{$_}";
}
close( TAGS );
sub check_shell
{
local( $_ ) = @_;
# read the first line of a script, and work out which shell it is,
# unless a shell was specified on the command line
#
# This routine can't handle clever scripts which start sh and then
if( $opt_s )
{
$shell = $opt_s;
}
else
{
$shell = "sh" if /^:$/ || /^ $shell = "ksh" if /^ $shell = "perl" if /^ $shell = "tcl" if /^ printf "Using $shell for $ARGV\n";
}
}