contrib / blameview / blameview.perlon commit add update 'none' flag to disable update of submodule by default (322bb6e)
   1#!/usr/bin/perl
   2
   3use Gtk2 -init;
   4use Gtk2::SimpleList;
   5
   6my $hash;
   7my $fn;
   8if ( @ARGV == 1 ) {
   9        $hash = "HEAD";
  10        $fn = shift;
  11} elsif ( @ARGV == 2 ) {
  12        $hash = shift;
  13        $fn = shift;
  14} else {
  15        die "Usage blameview [<rev>] <filename>";
  16}
  17
  18Gtk2::Rc->parse_string(<<'EOS');
  19style "treeview_style"
  20{
  21  GtkTreeView::vertical-separator = 0
  22}
  23class "GtkTreeView" style "treeview_style"
  24EOS
  25
  26my $window = Gtk2::Window->new('toplevel');
  27$window->signal_connect(destroy => sub { Gtk2->main_quit });
  28my $vpan = Gtk2::VPaned->new();
  29$window->add($vpan);
  30my $scrolled_window = Gtk2::ScrolledWindow->new;
  31$vpan->pack1($scrolled_window, 1, 1);
  32my $fileview = Gtk2::SimpleList->new(
  33    'Commit' => 'text',
  34    'FileLine' => 'text',
  35    'Data' => 'text'
  36);
  37$scrolled_window->add($fileview);
  38$fileview->get_column(0)->set_spacing(0);
  39$fileview->set_size_request(1024, 768);
  40$fileview->set_rules_hint(1);
  41$fileview->signal_connect (row_activated => sub {
  42                my ($sl, $path, $column) = @_;
  43                my $row_ref = $sl->get_row_data_from_path ($path);
  44                system("blameview @$row_ref[0]~1 $fn &");
  45                });
  46
  47my $commitwindow = Gtk2::ScrolledWindow->new();
  48$commitwindow->set_policy ('GTK_POLICY_AUTOMATIC','GTK_POLICY_AUTOMATIC');
  49$vpan->pack2($commitwindow, 1, 1);
  50my $commit_text = Gtk2::TextView->new();
  51my $commit_buffer = Gtk2::TextBuffer->new();
  52$commit_text->set_buffer($commit_buffer);
  53$commitwindow->add($commit_text);
  54
  55$fileview->signal_connect (cursor_changed => sub {
  56                my ($sl) = @_;
  57                my ($path, $focus_column) = $sl->get_cursor();
  58                my $row_ref = $sl->get_row_data_from_path ($path);
  59                my $c_fh;
  60                open($c_fh,  '-|', "git cat-file commit @$row_ref[0]")
  61                                        or die "unable to find commit @$row_ref[0]";
  62                my @buffer = <$c_fh>;
  63                $commit_buffer->set_text("@buffer");
  64                close($c_fh);
  65                });
  66
  67my $fh;
  68open($fh, '-|', "git cat-file blob $hash:$fn")
  69  or die "unable to open $fn: $!";
  70
  71while(<$fh>) {
  72  chomp;
  73  $fileview->{data}->[$.] = ['HEAD', "$fn:$.", $_];
  74}
  75
  76my $blame;
  77open($blame, '-|', qw(git blame --incremental --), $fn, $hash)
  78    or die "cannot start git-blame $fn";
  79
  80Glib::IO->add_watch(fileno($blame), 'in', \&read_blame_line);
  81
  82$window->show_all;
  83Gtk2->main;
  84exit 0;
  85
  86my %commitinfo = ();
  87
  88sub flush_blame_line {
  89        my ($attr) = @_;
  90
  91        return unless defined $attr;
  92
  93        my ($commit, $s_lno, $lno, $cnt) =
  94            @{$attr}{qw(COMMIT S_LNO LNO CNT)};
  95
  96        my ($filename, $author, $author_time, $author_tz) =
  97            @{$commitinfo{$commit}}{qw(FILENAME AUTHOR AUTHOR-TIME AUTHOR-TZ)};
  98        my $info = $author . ' ' . format_time($author_time, $author_tz);
  99
 100        for(my $i = 0; $i < $cnt; $i++) {
 101                @{$fileview->{data}->[$lno+$i-1]}[0,1,2] =
 102                (substr($commit, 0, 8), $filename . ':' . ($s_lno+$i));
 103        }
 104}
 105
 106my $buf;
 107my $current;
 108sub read_blame_line {
 109
 110        my $r = sysread($blame, $buf, 1024, length($buf));
 111        die "I/O error" unless defined $r;
 112
 113        if ($r == 0) {
 114                flush_blame_line($current);
 115                $current = undef;
 116                return 0;
 117        }
 118
 119        while ($buf =~ s/([^\n]*)\n//) {
 120                my $line = $1;
 121
 122                if (($commit, $s_lno, $lno, $cnt) =
 123                    ($line =~ /^([0-9a-f]{40}) (\d+) (\d+) (\d+)$/)) {
 124                        flush_blame_line($current);
 125                        $current = +{
 126                                COMMIT => $1,
 127                                S_LNO => $2,
 128                                LNO => $3,
 129                                CNT => $4,
 130                        };
 131                        next;
 132                }
 133
 134                # extended attribute values
 135                if ($line =~ /^(author|author-mail|author-time|author-tz|committer|committer-mail|committer-time|committer-tz|summary|filename) (.*)$/) {
 136                        my $commit = $current->{COMMIT};
 137                        $commitinfo{$commit}{uc($1)} = $2;
 138                        next;
 139                }
 140        }
 141        return 1;
 142}
 143
 144sub format_time {
 145  my $time = shift;
 146  my $tz = shift;
 147
 148  my $minutes = $tz < 0 ? 0-$tz : $tz;
 149  $minutes = ($minutes / 100)*60 + ($minutes % 100);
 150  $minutes = $tz < 0 ? 0-$minutes : $minutes;
 151  $time += $minutes * 60;
 152  my @t = gmtime($time);
 153  return sprintf('%04d-%02d-%02d %02d:%02d:%02d %s',
 154                 $t[5] + 1900, @t[4,3,2,1,0], $tz);
 155}