#!/bin/sh
exec perl -w -x -S $0 ${1+"$@"} # -*-perl-*-
#!perl -w

if ($] !~ /^5\..*/) { # uh-oh. this isn't perl 5.
  foreach (split(/:/, $ENV{PATH})) { # try to find "perl5".
    exec("$_/perl5", "-w", "-x", "-S", $0, @ARGV) if (-x "$_/perl5");
  }
  die "Your perl is too old; I need perl 5\n";
}

# load the real script. this is isolated in an 'eval' so perl4 won't
# choke at compile-time on the perl5-isms and die with a confusing error.
eval join("\n", <DATA>);
if ($@) { die "$@"; }
__END__
# real diffbrowse starts here
#
# diffbrowse: Browse through unified diff output with a pretty Tk interface.
# 
# Written by Nat Lanza (magus+diffbrowse@cs.cmu.edu)
#
# Licensing info:
#
#   Copyright (c) 2000, Nat Lanza
#   All rights reserved.
#
#   Redistribution and use, with or without modification, are
#   permitted provided that the following conditions are met:
# 
#    * Redistributions of source code must retain the above copyright
#      notice, this list of conditions and the following disclaimer.
#  
#    * Redistributions in binary form must reproduce the above
#      copyright notice, this list of conditions and the following
#      disclaimer in the documentation and/or other materials provided
#      with the distribution.
#
#   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
#   CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
#   INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
#   MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
#   DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
#   CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
#   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
#   LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
#   USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
#   AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
#   LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
#   ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
#   POSSIBILITY OF SUCH DAMAGE.
#
#   Users of this software are encouraged but not required to
#   contribute changes back to the author.

use strict;
use Tk;
require Tk::HList;
require Tk::ItemStyle;
require Tk::ROText;

my $SMALL_PATCH_SIZE = 1024;
my $MAX_DEPTH        = 5;
my $START_CLIMIT     = 6;

my ($prog_name) = ($0 =~ m|([^/]+)$|);
my $filename = shift or die "usage: $prog_name <diff file>\n";

my ($oldtree, $newtree);
my %tree;

###########################
# build the basic interface

my ($basename) = ($filename =~ m|([^/]+)$|);
my $main = MainWindow->new(-title => "$prog_name: $basename");

my $menubar = $main->Frame(relief => 'raised')
                   ->pack(fill => 'x',
			  side => 'top');
my $bottom  = $main->Frame(relief => 'ridge')
                   ->pack(fill => 'x',
			  padx => 3,
			  side => 'bottom');
my $top     = $main->Frame(relief => 'ridge')
                   ->pack(fill => 'both', side => 'top', expand => 1);

##### bottom frame buttons and such
$bottom->Button(text=>'Quit', command => sub { exit(0); })
       ->pack(fill => 'none', pady => 3, side =>'right');
$bottom->Button(text=>'Info', command => \&show_info )
       ->pack(fill => 'none', pady => 3, side =>'right');
$bottom->Label(text   => "$filename",
	       anchor => 'center',
	       relief => 'groove',
	       height => '1')
       ->pack(fill => 'x', expand => 1, padx => 3, side => 'left');

##### menubar

my $file_menu = $menubar->Menubutton(text        => 'File',
				     relief      => 'raised',
				     -tearoff    => 0,
				     borderwidth => 2)
                        ->pack(side => 'left',
			       padx => 2);
$file_menu->command(-label       => 'Info',
		    accelerator => 'C+i',
		    underline   => 0,
		    command     => \&show_info);

$file_menu->command(-label       => 'Quit',
		    accelerator => 'C+q',
		    underline   => 0,
		    command     => sub { exit(0); });

##### actual hlist stuff
my $hlist = $top->Scrolled('HList', -width => 40, -height => 30,
			   -scrollbars => 'osoe',
			   relief      => 'sunken',
			   -background => 'white',
			   -selectforeground => 'red',
			   drawbranch  => 1,
			   indent      => 15,
			   separator   => '/',
			   command     => \&expand_or_collapse)
                ->pack(fill   => 'both', padx => 3, pady => 1, expand => 1);

$hlist->ItemStyle('text', -stylename  => 'dir',
		  -background => 'white', -foreground => 'blue');
$hlist->ItemStyle('text', -stylename  => 'file',
		  -background => 'white', -foreground => 'black');
$hlist->ItemStyle('text', -stylename  => 'patch',
		  -background => 'white', -foreground => 'grey50');

##### keybindings
$hlist->bind('<Button-4>', sub { $hlist->yview('scroll', -3, 'units'); });
$hlist->bind('<Button-5>', sub { $hlist->yview('scroll',  3, 'units'); });

$main->bind('<Control-q>', sub { exit(0); });
$main->bind('<Control-w>', sub { exit(0); });
$main->bind('<Control-i>', \&show_info);

#################
# parse diff

{
  no strict 'refs';
  if ($filename =~ m|\.gz$|) { # gzipped
    open($filename, "gzip -dc < $filename|")
      or die "Can't open $filename: $!\n";
  } elsif ($filename =~ m|\.bz$|) { # bzipped
    open($filename, "bzip2 -dc < $filename|")
      or die "Can't open $filename: $!\n";
  } else {
    open($filename, $filename) or die "Can't open $filename: $!\n";
  }
  
  $tree{name} = '[ROOT]';
  $tree{type} = 'dir';
  $tree{children} = undef;
  
  # read in patchfile
  my $cur_entry = \%tree;

  my $chunk_lineno = 0;
  while (<$filename>) {
    if (m|^diff|) { $chunk_lineno = 0; next; }

    if ($chunk_lineno++ < 2) { # grab the new and old file info
      if (m|^\-\-\-\s+([^\s]+)|) {
	my ($oldpath, $oldfile) = ($1, '');
	($oldtree, $oldfile) = ($oldpath =~ m|^([^/]+)/(.+)|);
	$cur_entry = get_or_set_entry($oldfile);
      } elsif (m|^\+\+\+\s+([^\s]+)|) { 
	my ($newpath, $newfile) = ($1, '');
	($newtree, $newfile) = ($newpath =~ m|^([^/]+)/(.+)|);      
      } else { die "I don't understand line $.!\n"; }
    } else { $cur_entry->{raw_patch} .= $_; }
  }
  
  close $filename;
}

#############
# we want to do something sane with the initial display, so build 

for (sort keys %{$tree{children}}) {
  if (defined $tree{children}{$_}->{children}) { # dir
    $hlist->add($_, -itemtype => 'text', -style =>  'dir', -text => $_);    
    expand_directory($tree{children}{$_}, $_, $MAX_DEPTH, $START_CLIMIT);
  } else { # file
    $hlist->add($_, -itemtype => 'text', -style => 'file', -text => $_);
  }
}

Tk::MainLoop();


####################################
####################################


sub expand_or_collapse {
  my ($path) = @_;
  my $next_entry = $hlist->info('next', $path);

  my ($parent, $child) = ($path =~ m|^(.+)/([^/]+)$|);

  my $f_ref = get_entry($path);

  if (!$next_entry || (index ($next_entry, "$path/") == -1)) {
    if (!defined $f_ref) { # not a real file
      if ((!defined $parent) || (!defined $child)) { die "dammit."; }
      expand_patch(get_entry($parent), $child);
    } elsif (defined $f_ref->{children}) { # directory
      expand_directory($f_ref, $path, 0, undef);
    } else {
      expand_file($f_ref, $path);
    }
  } else { $hlist->delete('offsprings', $path); }
}

sub expand_file {
  my ($f_ref, $name) = @_;

  my $oldcursor = $main->cget('cursor');
  $main->configure(cursor => 'watch');
  $top->update();

  if (!defined $f_ref->{patches}) { parse_patch($f_ref); }

  for (1 .. @{$f_ref->{patches}}) {
    my $text = "Chunk $_ (" . $f_ref->{patches}[$_-1]{len} .
      " lines at " . $f_ref->{patches}[$_-1]{start} . ")";
    $hlist->add("$name/$_",
		-itemtype => 'text', -style => 'patch', -text => $text);
  }

  $main->configure(cursor => $oldcursor);
}


sub maybe_expand_file {
  my ($f_ref, $name, $c_lim) = @_;
  
  if (!defined $f_ref->{patches}) {
    return if (length($f_ref->{raw_patch}) > $SMALL_PATCH_SIZE);
    parse_patch($f_ref);
  }

  expand_file($f_ref, $name) if (scalar(@{$f_ref->{patches}}) <= $c_lim);
}

sub expand_directory {
  my ($d_ref, $name, $recurse, $c_lim) = @_;

  foreach (sort keys %{$d_ref->{children}}) {
    my $f_ref = $d_ref->{children}{$_};

    if (defined $f_ref->{children}) { # directory
      $hlist->add("$name/$_",
		  -itemtype => 'text', -style => 'dir', -text => $_);
      if ($recurse) {
	if (defined $c_lim) {
	  if (scalar(keys %{$f_ref->{children}}) <= $c_lim) {
	    expand_directory($f_ref, "$name/$_",
			     $recurse-1, $c_lim-2);
	  }
	} else {
	  expand_directory($f_ref, "$name/$_",
			   $recurse-1, $c_lim-2);
	} 
      }
    } else {
      $hlist->add("$name/$_",
		  -itemtype => 'text', -style => 'file', -text => $_);
      if ($recurse) {
	maybe_expand_file($f_ref, "$name/$_", $c_lim-2);
      }
    }
  }
}

sub expand_patch {
  my ($f_ref, $patchno) = @_;

  my $oldcursor = $main->cget('cursor');
  $main->configure(cursor => 'watch');
  $top->update();

  if (!defined $f_ref->{patches}) { parse_patch($f_ref); }

  my $name     = $f_ref->{name};
  my $change   = $f_ref->{patches}[$patchno-1]{change};
  my $contents = $f_ref->{patches}[$patchno-1]{contents};
  my $len      = $f_ref->{patches}[$patchno-1]{len};
  my $start    = $f_ref->{patches}[$patchno-1]{start};

  my $pwin = $main->Toplevel(-title => "File $name, chunk $patchno");

  my $ptop = $pwin->Frame()->pack(fill => 'x', side => 'top');
  my $pmid = $pwin->Frame()->pack(fill => 'both', expand => 1);
  my $pbot = $pwin->Frame()->pack(fill => 'x', side => 'bottom');

  my $len_text;
  if ($len > 1) { $len_text = "$len lines long"; }
  else          { $len_text = "$len line long";  }

  my $add_text;
  if    ($change  >  1) { $add_text = "Adds $change lines";             }
  elsif ($change ==  1) { $add_text = "Adds 1 line";                    }
  elsif ($change == -1) { $add_text = "Removes 1 line";                 }
  elsif ($change  <  0) { $add_text = "Removes " . -$change . " lines"; }
  else                  { $add_text = "---";                            }

  $ptop->Label(text   => "Chunk $patchno of file $name, at line $start",
	       relief => 'raised',
	       height => '1')
       ->pack(fill => 'x', expand => 1, side => 'top');

  my $tbox = $pmid->Scrolled('ROText',
			     -scrollbars => 'osoe',
			     -wrap       => 'none',
			     -background => 'white',
			     -relief     => 'sunken')
                  ->pack(fill => 'both', padx => 3, pady => 3, expand => 1);

  $pwin->bind('<KeyPress-w>', sub { $pwin->destroy(); });
  $pwin->bind('<KeyPress-q>', sub { exit(0); });
  $tbox->bind('<Button-4>', sub { $tbox->yview('scroll', -3, 'units'); });
  $tbox->bind('<Button-5>', sub { $tbox->yview('scroll',  3, 'units'); });

  $tbox->tagConfigure('add',    -foreground => 'blue');
  $tbox->tagConfigure('del',    -foreground => 'red');

  $tbox->delete("1.0","end");
  my $index = 1;

  for (split /\n/, $contents) {
    $_ .= "\n";
    if (/^\+/) {
      $tbox->insert("$index.0", "$_", 'add');
    } elsif (/^\-/) {
      $tbox->insert("$index.0", "$_", 'del');
    } else {
      $tbox->insert("$index.0", "$_");
    }
    $index += length($_);
  }

  $tbox->markSet("blanklinestart","end");

  $pbot->Label(text   => $len_text,
	       relief => 'ridge',
	       height => '1')->pack(fill => 'x', expand => 1, side => 'left');
  $pbot->Label(text   => $add_text,
	       relief => 'ridge',
	       height => '1')->pack(fill => 'x', expand => 1, side => 'left');
  $pbot->Button(text    => 'Close',
		command => sub { $pwin->destroy(); })
       ->pack(fill => 'none', expand => 0, side =>'right');

  $main->configure(cursor => $oldcursor);
}

#######################

sub get_entry {
  my ($path) = @_;
  my @pathelem = split(/\//, $path);
    
  my $t_cur = \%tree;

  for (@pathelem) {
    return undef unless defined($t_cur->{children}{$_});
    $t_cur = $t_cur->{children}{$_};
  }

  return $t_cur;
}

sub get_or_set_entry {
  my ($path) = @_;
  my @pathelem = split(/\//, $path);
  my $t_cur = \%tree;

  for (@pathelem) {
    if (!defined($t_cur->{children}{$_})) {
      $t_cur->{children}{$_}{name} = $_;
      $t_cur->{children}{$_}{children} = undef;
    }

    $t_cur = $t_cur->{children}{$_};
  }

  return $t_cur;
}

sub parse_patch {
  my ($f_ref) = @_;

  die "no patch!" unless defined $f_ref->{raw_patch};
  
  if ($f_ref->{raw_patch} !~ m|^\@\@|) { die "Bad patch!\n"; }
  my @lines = split /\n/, $f_ref->{raw_patch};

  undef $f_ref->{raw_patch}; # clean up
  $f_ref->{patches} = ();

  my $chunkno = -1;

  for (@lines) {
    if (m|\@\@|) {
      $chunkno++; # new chunk
      
      my ($oldline, $oldlen, $newline, $newlen) = 
	(m|^\@\@\s+\-([0-9]+),([0-9]+)\s+\+([0-9]+),([0-9]+)+\s+\@\@|);
      my $change = $newlen - $oldlen;

      $f_ref->{patches}[$chunkno]{change} = $change;
      $f_ref->{patches}[$chunkno]{len}    = $newlen;
      $f_ref->{patches}[$chunkno]{start}  = $oldline;
    } else {
      $f_ref->{patches}[$chunkno]{contents} .= "$_\n";
    }
  }
}

sub show_info {
  my $oldcursor = $main->cget('cursor');
  $main->configure(cursor => 'watch');
  $top->update();

  my $iwin = $main->Toplevel(-title => "Info: $filename");

  my $ibot = $iwin->Frame(relief => 'ridge')
                  ->pack(fill => 'x', padx => 3, side => 'bottom');
  my $itop = $iwin->Frame(relief => 'ridge')
                  ->pack(fill => 'both', side => 'top', expand => 1);

  $ibot->Button(text    => 'Close',
		command => sub { $iwin->destroy(); })
       ->pack(fill => 'none', expand => 0, pady => 3, side => 'right');

  $ibot->Label(text   => "Info: $filename",
	       anchor => 'center',
	       relief => 'groove')
       ->pack(fill => 'x', expand => 1, padx => 3, side => 'left');

  my $itext = "(not yet implemented)";

  $itop->Label(text   => $itext,
	       anchor => 'center',
	       background => 'white',
	       width  => 30,
	       height => 10,
	       relief => 'sunken')
       ->pack(fill => 'both', padx => 3, pady => 1, expand => 1);

  $iwin->bind('<KeyPress-w>', sub { $iwin->destroy(); });
  $iwin->bind('<KeyPress-q>', sub { exit(0); });

  $main->configure(cursor => $oldcursor);
}