xref: /vim-8.2.3635/runtime/tools/shtags.pl (revision 91359014) 
1#!/usr/bin/env perl
2#
3# shtags: create a tags file for perl scripts
4#
5# Author:	Stephen Riehm
6# Updated by: David Woodfall <[email protected]>
7# Last Changed:	2018/04/02
8#
9
10use Getopt::Std;
11
12# obvious... :-)
13sub usage
14    {
15    print <<_EOUSAGE_ ;
16USAGE: $program [-kvwVx] [-t <file>] <files>
17    -t <file>	Name of tags file to create. (default is 'tags')
18    -s <shell>	Name of the shell language in the script
19    -v		Include variable definitions.
20		(variables mentioned at the start of a line)
21    -V		Print version information.
22    -w		Suppress "duplicate tag" warnings.
23    -x		Explicitly create a new tags file. Normally tags are merged.
24    <files>	List of files to scan for tags.
25_EOUSAGE_
26    exit 0
27    }
28
29sub version
30{
31    #
32    # Version information
33    #
34    @id = split( ', ', 'scripts/bin/shtags, /usr/local/, LOCAL_SCRIPTS, 1.2, 18/04/02, 07:37' );
35    $id[0] =~ s,.*/,,;
36    print <<_EOVERS;
37$id[0]:		$id[3]
38Last Modified:	@id[4,5]
39Component:	$id[1]
40Release:	$id[2]
41_EOVERS
42    exit( 1 );
43}
44
45#
46# initialisations
47#
48($program = $0) =~ s,.*/,,;
49
50#
51# parse command line
52#
53getopts( "t:s:vVwx" ) || &usage();
54$tags_file = $opt_t || 'tags';
55$explicit = $opt_x;
56$variable_tags = $opt_v;
57$allow_warnings = ! $opt_w;
58&version	  if $opt_V;
59&usage()	unless @ARGV != 0;
60
61# slurp up the existing tags. Some will be replaced, the ones that aren't
62# will be re-written exactly as they were read
63if( ! $explicit && open( TAGS, "< $tags_file" ) )
64    {
65    while( <TAGS> )
66	{
67	/^\S+/;
68	$tags{$&} = $_;
69	}
70    close( TAGS );
71    }
72
73#
74# for each line of every file listed on the command line, look for a
75# 'sub' definition, or, if variables are wanted as well, look for a
76# variable definition at the start of a line
77#
78while( <> )
79    {
80    &check_shell($_), ( $old_file = $ARGV ) if $ARGV ne $old_file;
81    next unless $shell;
82    if( $shell eq "sh" )
83	{
84	next	unless /^\s*(((\w+)))\s*\(\s*\)/
85		    || ( $variable_tags && /^(((\w+)=))/ );
86	$match = $3;
87	}
88    if( $shell eq "ksh" )
89	{
90	# ksh
91	next	unless /^\s*function\s+(((\w+)))/
92		    || ( $variable_tags && /^(((\w+)=))/ );
93	$match = $3;
94	}
95    if( $shell eq "perl" )
96	{
97	# perl
98	next	unless /^\s*sub\s+(\w+('|::))?(\w+)/
99		    || /^\s*(((\w+))):/
100		    || ( $variable_tags && /^(([(\s]*[\$\@\%]{1}(\w+).*=))/ );
101	$match = $3;
102	}
103    if( $shell eq "tcl" )
104	{
105	next	unless /^\s*proc\s+(((\S+)))/
106		    || ( $variable_tags && /^\s*set\s+(((\w+)\s))/ );
107	$match = $3;
108	}
109    chop;
110    warn "$match - duplicate ignored\n"
111	if ( $new{$match}++
112	    || !( $tags{$match} = sprintf( "%s\t%s\t?^%s\$?\n", $match, $ARGV, $_ ) ) )
113	    && $allow_warnings;
114    }
115
116# write the new tags to the tags file - note that the whole file is rewritten
117open( TAGS, "> $tags_file" );
118foreach( sort( keys %tags ) )
119    {
120    print TAGS "$tags{$_}";
121    }
122close( TAGS );
123
124sub check_shell
125    {
126    local( $_ ) = @_;
127    # read the first line of a script, and work out which shell it is,
128    # unless a shell was specified on the command line
129    #
130    # This routine can't handle clever scripts which start sh and then
131    # use sh to start the shell they really wanted.
132    if( $opt_s )
133	{
134	$shell = $opt_s;
135	}
136    else
137	{
138	$shell = "sh"	if /^:$/ || /^#!.*\/bin\/sh/;
139	$shell = "ksh"	if /^#!.*\/ksh/;
140	$shell = "perl"	if /^#!.*\/perl/;
141	$shell = "tcl"  if /^#!.*\/wish/;
142	printf "Using $shell for $ARGV\n";
143	}
144    }
145