]>
Commit | Line | Data |
---|---|---|
cace16fd JK |
1 | #!/usr/bin/perl |
2 | ||
3 | use Gtk2 -init; | |
4 | use Gtk2::SimpleList; | |
5 | ||
3fb62452 AK |
6 | my $hash; |
7 | my $fn; | |
8 | if ( @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 | } | |
cace16fd JK |
17 | |
18 | Gtk2::Rc->parse_string(<<'EOS'); | |
19 | style "treeview_style" | |
20 | { | |
21 | GtkTreeView::vertical-separator = 0 | |
22 | } | |
23 | class "GtkTreeView" style "treeview_style" | |
24 | EOS | |
25 | ||
26 | my $window = Gtk2::Window->new('toplevel'); | |
27 | $window->signal_connect(destroy => sub { Gtk2->main_quit }); | |
07fef5fc AK |
28 | my $vpan = Gtk2::VPaned->new(); |
29 | $window->add($vpan); | |
cace16fd | 30 | my $scrolled_window = Gtk2::ScrolledWindow->new; |
07fef5fc | 31 | $vpan->pack1($scrolled_window, 1, 1); |
cace16fd JK |
32 | my $fileview = Gtk2::SimpleList->new( |
33 | 'Commit' => 'text', | |
cace16fd JK |
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); | |
3fb62452 AK |
41 | $fileview->signal_connect (row_activated => sub { |
42 | my ($sl, $path, $column) = @_; | |
43 | my $row_ref = $sl->get_row_data_from_path ($path); | |
ae648606 | 44 | system("blameview @$row_ref[0]~1 $fn &"); |
07fef5fc AK |
45 | }); |
46 | ||
47 | my $commitwindow = Gtk2::ScrolledWindow->new(); | |
48 | $commitwindow->set_policy ('GTK_POLICY_AUTOMATIC','GTK_POLICY_AUTOMATIC'); | |
49 | $vpan->pack2($commitwindow, 1, 1); | |
50 | my $commit_text = Gtk2::TextView->new(); | |
51 | my $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); | |
3fb62452 | 65 | }); |
cace16fd | 66 | |
73a2acc0 | 67 | my $fh; |
3fb62452 | 68 | open($fh, '-|', "git cat-file blob $hash:$fn") |
cace16fd | 69 | or die "unable to open $fn: $!"; |
3fb62452 | 70 | |
cace16fd JK |
71 | while(<$fh>) { |
72 | chomp; | |
07fef5fc | 73 | $fileview->{data}->[$.] = ['HEAD', "$fn:$.", $_]; |
cace16fd JK |
74 | } |
75 | ||
76 | my $blame; | |
3fb62452 | 77 | open($blame, '-|', qw(git blame --incremental --), $fn, $hash) |
cace16fd JK |
78 | or die "cannot start git-blame $fn"; |
79 | ||
80 | Glib::IO->add_watch(fileno($blame), 'in', \&read_blame_line); | |
81 | ||
82 | $window->show_all; | |
83 | Gtk2->main; | |
84 | exit 0; | |
85 | ||
86 | my %commitinfo = (); | |
87 | ||
88 | sub 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] = | |
07fef5fc | 102 | (substr($commit, 0, 8), $filename . ':' . ($s_lno+$i)); |
cace16fd JK |
103 | } |
104 | } | |
105 | ||
106 | my $buf; | |
107 | my $current; | |
108 | sub 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 | ||
144 | sub 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 | } |