#!/usr/bin/perl -w

#    inheritanCe is a tool for browsing the class inheritance tree for a
#    programming language supported by exuberant ctags
#    (http://ctags.sourceforge.net/).
#
#    To use it, add the '--fields=+i' option to the ctags call when creating
#    the tags file.
#
#    You will have a command history and nice command line editing if you have
#    the Term::ReadLine::Gnu module installed. It isn't required though.
#

#
#    Copyright (C) 2002 Jochen Suckfuell <Jochen at Suckfuell dot Net>
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#

#====================  Changelog  =========================

#
# 2002/04/27 Release 1.2 (major feature enhancements)
#
#   - remote control editor to jump to class definition
#   - command line parameter overrides tags file name
#   - added command line options
#   - added 'grep <pattern>' command
#   - 'suppress' command to not display certain classes in tree view
#   - enable tab completion for classes
#   - less restrictive: find ... child[ren], find ... parent[s]
#   - removed add_history calls; they lead to double entries
#
# 2002/04/25 Release 1.0 (initial release)
#
#

#================  Configuration options  =================

my $tags_file = 'tags'; # overridden by first command line option
my $jump_cmd = 'vim --servername <vimserver> --remote-send ":tjump <class><RETURN>"'; # command to
					# direct your preferred editor to the class definition
my $vimserver = "GVIM"; # This is the string after the '-' in gvim's window title.
								# If you use another editor, you can use the <vimserver> string in $jump_cmd
								# for substitution with any parameter for the editor, according to the -V
								# command line option.

#==============  no configuration below  ==================

my $version = "1.2";

use strict;
use vars qw/%inherits %children @suppress $opt_h $opt_v $opt_V $opt_f/;

use Getopt::Std;
getopts("f:V:vh");

if($opt_h)
{
	show_version();
	show_help();
	exit 0;
}
if($opt_v)
{
	show_version();
	exit 0;
}

if($opt_f)
{
	$tags_file = $opt_f;
}

if($opt_V)
{
	$vimserver = $opt_V;
}

use Term::ReadLine;
my $term = new Term::ReadLine "inheritanCe";

show_version();

@suppress = ();

parse_tags_file();

build_children_hash();

# set cmdline completion to complete class names
my $attribs = $term->Attribs;
$attribs->{completion_entry_function} = $attribs->{list_completion_function};
$attribs->{completion_word} = [ keys %children ];

show_help();

#=============  main loop  =============================
for(;;)
{
	my $cmd;
	if(! defined ($cmd = $term->readline("> ")) )
	{
		print "\n";
		last;
	}
	
	$cmd =~ s/^\s+//;
	
	if(!$cmd) { next; }
	elsif($cmd =~ /^(?:quit|exit|bye)$/) { last; }
	elsif($cmd =~ /^parents\s+(\d*)/g)
	{
		my $levels = 1;
		if($1) { $levels = $1; }
		
		my @classes = ($cmd =~ /\S+/g);
		foreach my $class (@classes)
		{
			parents_recursive($class, $levels, "");
			print "\n";
		}
	}
	elsif($cmd =~ /^children\s+(\d*)/g)
	{
		my $levels = 1;
		if($1) { $levels = $1; }
		
		my @classes = ($cmd =~ /\S+/g);
		foreach my $class (@classes)
		{
			children_recursive($class, $levels, "");
			print "\n";
		}
	}
	elsif($cmd =~ /^grep\s+(\S+)/)
	{
		print join (", ", grep ( /$1/, keys %children )), "\n";
	}
	elsif($cmd =~ /^find\s+(\S+)\s+parents?(?:\s+(\S*))?$/)
	{
		my $pattern = ".";
		if($2) { $pattern = $2; }
		if(!find_parents($1, $pattern, ""))
		{
			print "Class '$1' has no parent matching /$2/\n";
		}
	}
	elsif($cmd =~ /^find\s+(\S+)\s+child(?:ren)?(?:\s+(\S*))?$/)
	{
		my $pattern = ".";
		if($2) { $pattern = $2; }
		if(!find_children($1, $pattern, ""))
		{
			print "Class '$1' has no child matching /$2/\n";
		}
	}
	elsif($cmd =~ /^suppress\s*/g)
	{
		my @classes = ($cmd =~ /\S+/g);
		foreach my $class (@classes)
		{
			if(defined $children{$class})
			{
				push @suppress, $class;
			}
			else
			{
				print "+ Skipped unknown class '$class'\n";
			}
		}
		show_suppressed();
	}
	elsif($cmd =~ /^unsuppress\s*/g)
	{
		my @patterns = ($cmd =~ /\S+/g);
		my @new_suppress = ();
		foreach my $sup (@suppress)
		{
			my $keep = 1;
			foreach my $pat (@patterns)
			{
				if($sup =~ /$pat/)
				{
					$keep = 0;
					last;
				}
			}
			if($keep)
			{
				push @new_suppress, $sup;
			}
		}
		@suppress = @new_suppress;
		show_suppressed();
	}
	elsif($cmd =~ /^goto\s+(\S+)/)
	{
		my $class = $1;
		(my $goto_cmd = $jump_cmd) =~ s/<class>/$class/g;
		$goto_cmd =~ s/<vimserver>/$vimserver/g;
		system ($goto_cmd);
		print "+ executed '$goto_cmd'\n";
	}
	elsif($cmd =~ /^help\b/)
	{
		show_help();
	}
	elsif($cmd =~ /^version\b/)
	{
		show_version();
	}
	else
	{
		$cmd =~ /^\S+/;
		print "Unknown command '$&'\n";
		show_help();
	}
}

exit 0;

#===================  functions  =========================

sub find_parents
{
	my $class = shift;
	my $pattern = shift;
	my $path = shift;

	if(! defined $inherits{$class})
	{
		if($path =~ /^$/)
		{
			print "+ Nothing known about class '$class'\n";
			return 1;
		}
		return 0;
	}

	my $reported = 0;
	foreach my $parent (split /\n/, $inherits{$class})
	{
		if($parent =~ m/$pattern/)
		{
			print "$path <- $parent\n";
			$reported = 1;
		}
		if(find_parents($parent, $pattern, $path." <- $parent")) { $reported = 1; }
	}
	return $reported;
}
		
sub find_children
{
	my $class = shift;
	my $pattern = shift;
	my $path = shift;

	if(! defined $children{$class})
	{
		if($path =~ /^$/)
		{
			print "+ Nothing known about class '$class'\n";
			return 1;
		}
		return 0;
	}

	my $reported = 0;
	foreach my $child (split /\n/, $children{$class})
	{
		if($child =~ m/$pattern/)
		{
			print "$path -> $child\n";
			$reported = 1;
		}
		if(find_children($child, $pattern, $path." -> $child")) { $reported = 1; }
	}
	return $reported;
}
		
sub parents_recursive
{
	my $class = shift;
	my $levels = shift;
	my $prefix = shift;
	
	return if grep(/^$class$/, @suppress);
	
	if(defined $inherits{$class})
	{
		my $has_parents;
		my $one_to_one;
		if($inherits{$class} !~ /^$/) { $has_parents = "+"; }
		else { $has_parents = "-"; }
		
		if($children{$class} =~ /\n/m) { $one_to_one = "-"; }
		else { $one_to_one = "="; }

		print "$prefix+<$one_to_one$has_parents $class\n";
	}
	else
	{
		print "$prefix+<-? $class\n";
		return;
	}
	
	if($levels == 0) { return; }

	foreach my $parent (split /\n/, $inherits{$class})
	{
		parents_recursive($parent, $levels - 1, $prefix."|  ");
	}
}

sub children_recursive
{
	my $class = shift;
	my $levels = shift;
	my $prefix = shift;
	
	return if grep(/^$class$/, @suppress);
	
	if(defined $children{$class})
	{
		my $has_children;
		my $one_to_one;
		if($children{$class} !~ /^$/) { $has_children = "+"; }
		else { $has_children = "-"; }
		
		if((! defined $inherits{$class}) || ($inherits{$class} =~ /\n/m)) { $one_to_one = "-"; }
		else { $one_to_one = "="; }

		print "$prefix+$one_to_one>$has_children $class\n";
	}
	else
	{
		print "$prefix+->? $class\n";
		return;
	}
	
	if($levels == 0) { return; }

	foreach my $child (split /\n/, $children{$class})
	{
		children_recursive($child, $levels - 1, $prefix."|  ");
	}
}

sub show_help
{
	print  <<END_HELP;

Command line options:
     -h  show this help
     -v  show version
     -f  override default tags file name
     -V  parameter for the 'goto' editor call, substituted for <vimserver>

Available commands are:

          parents [<levels>=1] <class name>+
          children [<levels>=1] <class name>+
            In the output, a '=' in the tree means the relation is one-to-one.
            A '?' means that no tag entry could be found for this class.

          find <class> children [<child class pattern>=.]
          find <class> parents [<parent class pattern>=.]

          grep <class pattern>
            show all classes matching /pattern/

          suppress <class name>+
            Suppressed classes will not be shown in the trees produced by
            'parents' and 'children' commands
          unsuppress <class pattern>+
            all suppressed classes matching this pattern will not be suppressed
            any more. The pattern '.' matches everything.
          suppress
            without a parameter, this will show the classes currently suppressed

          goto <class name>
            sends your editor to the class tag

          help
          version
          quit

END_HELP
}

sub show_suppressed
{
	print "+ suppressed classes: ";
	foreach my $sup (@suppress)
	{
		print "$sup ";
	}
	print "\n";
}

sub show_version
{
	print <<END_VERSION;
inheritanCe $version, (C) 2002 Jochen Suckfuell <Jochen at Suckfuell dot net>
Licensed under the GNU General Public License.

END_VERSION
}

sub parse_tags_file
{
	print "+ Reading tags from file '$tags_file' ... \n";
	open TAGS, "< $tags_file" or die "\nCannot open file '$tags_file': $!";
	%inherits = ();
	while ( <TAGS> )
	{
		if( m#/;"\s+c\s+#g )
		{
			my $parents = "";
			if( /\binherits:(\S+)/g )
			{
				($parents = $1) =~ s/,/\n/g;
			}
			/^\S+/;
			my $class = $&;
			
			$inherits{$class} = $parents;
		}
	}
	close TAGS;
}

sub build_children_hash
{
	print "+ Building children hash table ...\n";
	foreach my $class (keys %inherits)
	{
		foreach my $parent (split /\n/, $inherits{$class})
		{
			if(defined $children{$parent})
			{
				if($children{$parent} !~ /\b$class\b/)
				{
					if($children{$parent} !~ /^$/)
					{
						$children{$parent} .= "\n$class";
					}
					else
					{
						$children{$parent} .= "$class";
					}
				}
			}
			else
			{
				$children{$parent} = $class;
			}
		} # foreach parent
		if(! defined $children{$class})
		{
			$children{$class} = "";
		}
	} # foreach class
}