#!/usr/bin/perl
#
# idltags - does for IDL what ctags/etags does for c
#
# Usage: idltags [options] directory [directory...]
#
# directory	- name of the directory/file to be tagged;
#		  if directory starts with @, all subdirectories are searched.
#
# Options:
#	--append	- appends to current tags/ILDTAGS file
#	--ctags		- generates tags file for vi (default)
#	--etags		- generates IDLTAGS file for [x]emacs (see note below)
#
# Note: Uses etags program to generate IDLTAGS.
# Note: To use IDLTAGS with [x]emacs you have to use the latest version
#       of idl-mode (idl.el), and/or put the following into your .emacs:
#
#	(setq tag-table-alist (append '(("\\.pro$" . "IDLTAGS"))))
#
# Author: Jim Heumann
#         October, 1996
# Modified: Lubos Pochman (added etags, options, rewritten)
#         November, 1996
#
# Version: 1.0
#
use strict;
use File::Find;
use Getopt::Long;
#################################################################
# Global Variables
#################################################################
my $theTagsFile = "tags.tmp";
my $eTagsCmd = "etags --output=IDLTAGS --language=none --regex='/[ \\t]*[pP][Rr][Oo][ \\t]+\\([^ \\t,]+\\)/' --regex='/[ \\t]*[Ff][Uu][Nn][Cc][Tt][Ii][Oo][Nn][ \\t]+\\([^ \\t,]+\\)/'";

my @files = ();
my $directory;
my $dir_sep = ($^O eq "VMS") ? "" : "/";

#################################################################
# Get Options
#################################################################
my $append;
my($use_ctags, $use_etags, $usage);
&GetOptions("append" => \$append,
	    "ctags"  => \$use_ctags,
	    "etags"  => \$use_etags,
	    "help"   => \$usage);
my $eTagsAppend = ($append) ? "--append" : "";
my $cTagsMode = $use_ctags || !$use_etags;

if ($usage) {
    print "Usage: idltags [options] directory [directory...]\n\n";
    print " directory	- name of the directory/files which files should be tagged;\n";
    print "		  if directory starts with @, all subdirectories are searched\n\n";
    print " Options:\n";
    print "	--append	- appends to current tags/ILDTAGS file\n";
    print "	--ctags		- generates tags file for vi (default)\n";
    print "	--etags		- generates IDLTAGS file for [x]emacs\n";
    exit;
}


#################################################################
# Main
#################################################################
#
# If ctags open tmp tags file
#
if ($cTagsMode) {
    open(TAGSFILE, ">$theTagsFile") or die "Can't open $theTagsFile file!\n";
}
#
# For all directories on cmd. line
#
foreach $directory (@ARGV) {
    my($file, $diritem, $status);
    #
    # Get the directory (and all subdirectories if requested)
    #
    @files = ();
    my $getsubdirs = 0;

    if (substr($directory, 0, 1) eq "@") {
	$directory = substr($directory, 1);
	$getsubdirs = 1;
    }
    if ( -d $directory) {
	if ($getsubdirs) {
	    find(\&wanted, $directory);
	} else {
	    $files[0] = $directory . $dir_sep . "*.pro";
	}
    } else {
	@files = glob $directory;
    }
    #
    # For the directory (and all subdirectories if requested)
    # generate tags/IDLTAGS file.
    #
    foreach $diritem (@files) {
	if ($cTagsMode) {
	    foreach $file (glob $diritem) {
		&CreateCTags($file);
	    }
	} else {
	    $status = `$eTagsCmd $eTagsAppend $diritem`;
	    $eTagsAppend = "--append";
	}
    }
}
#
# Sort the tmp file and create or append to tags file
if ($cTagsMode) {
    my $line;
    
    close(TAGSFILE);
    open(TAGSFILE, "$theTagsFile") or
	die "Can't open $theTagsFile file!\n";
    my @lines = sort <TAGSFILE>;
    close(TAGSFILE);
    unlink($theTagsFile) or warn "Could not delete $theTagsFile!\n";
    
    if ($append && (-w "tags")) {
	open(TAGS, "tags") or die "Can't open tags file!\n";
	push(@lines, <TAGS>);
	close(TAGS);
	@lines = sort @lines;
    }
    open(TAGS, ">tags") or die "Can't open tags file!\n";

    foreach $line (@lines) {
	print TAGS $line;
    }
    close(TAGS);
}

#
# Find callback
#	
sub wanted { push(@files, $File::Find::name . $dir_sep . "*.pro") if -d;}
#
# Create vi tags
#
sub CreateCTags {
    my($filename) = @_;
    my($wholeline, $mostofline, $junk, $secondword, $justname);
    my @allwords;

    if (!open(THEFILE, "$filename")) {
	warn "Cannot open $filename!";
	return;
    }

    while (<THEFILE>) {
	if (/^pro\b/i || /^function\b/i){
	    
	    $wholeline = $_;
	    ($mostofline, $junk) = split(/\$/,$wholeline);
	    
	    @allwords = split;
	    $secondword = $allwords[1];
	    
	    ($justname, $junk) = split(/,/, $secondword);
	    
	    chop($mostofline);
	    
	    print TAGSFILE "$justname\t$filename\t\/\^$mostofline\/\n";
	    
	}
    }
    close(THEFILE);
}