1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
|
#!/usr/bin/env perl
#
# shtags: create a tags file for perl scripts
#
# Author: Stephen Riehm
# Last Changed: 96/11/27 19:46:06
#
# "@(#) shtags 1.1 by S. Riehm"
#
# obvious... :-)
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
{
#
# Version information
#
@id = split( ', ', 'scripts/bin/shtags, /usr/local/, LOCAL_SCRIPTS, 1.1, 96/11/27, 19:46:06' );
$id[0] =~ s,.*/,,;
print <<_EOVERS;
$id[0]: $id[3]
Last Modified: @id[4,5]
Component: $id[1]
Release: $id[2]
_EOVERS
exit( 1 );
}
#
# initialisations
#
($program = $0) =~ s,.*/,,;
require 'getopts.pl';
#
# parse command line
#
&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;
# slurp up the existing tags. Some will be replaced, the ones that aren't
# will be re-written exactly as they were read
if( ! $explicit && open( TAGS, "< $tags_file" ) )
{
while( <TAGS> )
{
/^\S+/;
$tags{$&} = $_;
}
close( TAGS );
}
#
# for each line of every file listed on the command line, look for a
# 'sub' definition, or, if variables are wanted aswell, look for a
# variable definition at the start of a line
#
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" )
{
# ksh
next unless /^\s*function\s+(((\w+)))/
|| ( $variable_tags && /^(((\w+)=))/ );
$match = $3;
}
if( $shell eq "perl" )
{
# 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
# use sh to start the shell they really wanted.
if( $opt_s )
{
$shell = $opt_s;
}
else
{
$shell = "sh" if /^:$/ || /^#!.*\/bin\/sh/;
$shell = "ksh" if /^#!.*\/ksh/;
$shell = "perl" if /^#!.*\/perl/;
$shell = "tcl" if /^#!.*\/wish/;
printf "Using $shell for $ARGV\n";
}
}
|
