blob: 3444bac558965df1f84fefe9206b2c039343a483 [file] [log] [blame]
Paul Mackerras1db95b02005-05-09 04:08:39 +00001#!/bin/sh
2# Tcl ignores the next line -*- tcl -*- \
3exec wish "$0" -- "${1+$@}"
4
5# Copyright (C) 2005 Paul Mackerras. All rights reserved.
6# This program is free software; it may be used, copied, modified
7# and distributed under the terms of the GNU General Public Licence,
8# either version 2, or (at your option) any later version.
9
Paul Mackerras98f350e2005-05-15 05:56:51 +000010# CVS $Revision: 1.8 $
Paul Mackerras0327d272005-05-10 00:23:42 +000011
Paul Mackerras1db95b02005-05-09 04:08:39 +000012set datemode 0
13set boldnames 0
14set revtreeargs {}
Paul Mackerrase5c2d852005-05-11 23:44:54 +000015set diffopts "-U 5 -p"
Paul Mackerras1db95b02005-05-09 04:08:39 +000016
Paul Mackerrasb5721c72005-05-10 12:08:22 +000017set mainfont {Helvetica 9}
18set namefont $mainfont
Paul Mackerrase5c2d852005-05-11 23:44:54 +000019set textfont {Courier 9}
Paul Mackerrasb5721c72005-05-10 12:08:22 +000020if {$boldnames} {
21 lappend namefont bold
22}
Paul Mackerrase5c2d852005-05-11 23:44:54 +000023
24set colors {green red blue magenta darkgrey brown orange}
25set colorbycommitter false
26
Paul Mackerrasb5721c72005-05-10 12:08:22 +000027catch {source ~/.gitk}
28
Paul Mackerras1db95b02005-05-09 04:08:39 +000029foreach arg $argv {
30 switch -regexp -- $arg {
31 "^$" { }
Paul Mackerras1db95b02005-05-09 04:08:39 +000032 "^-b" { set boldnames 1 }
Paul Mackerrase5c2d852005-05-11 23:44:54 +000033 "^-c" { set colorbycommitter 1 }
34 "^-d" { set datemode 1 }
Paul Mackerras1db95b02005-05-09 04:08:39 +000035 "^-.*" {
36 puts stderr "unrecognized option $arg"
37 exit 1
38 }
39 default {
40 lappend revtreeargs $arg
41 }
42 }
43}
44
45proc getcommits {rargs} {
46 global commits parents cdate nparents children nchildren
47 if {$rargs == {}} {
48 set rargs HEAD
49 }
50 set commits {}
Paul Mackerras9a40c502005-05-12 23:46:16 +000051 if [catch {set clist [eval exec git-rev-tree $rargs]} err] {
52 if {[string range $err 0 4] == "usage"} {
53 puts stderr "Error reading commits: bad arguments to git-rev-tree"
54 puts stderr "Note: arguments to gitk are passed to git-rev-tree"
55 puts stderr " to allow selection of commits to be displayed"
56 } else {
57 puts stderr "Error reading commits: $err"
58 }
59 return 0
60 }
61 foreach c [split $clist "\n"] {
Paul Mackerras1db95b02005-05-09 04:08:39 +000062 set i 0
63 set cid {}
64 foreach f $c {
65 if {$i == 0} {
66 set d $f
67 } else {
68 set id [lindex [split $f :] 0]
69 if {![info exists nchildren($id)]} {
70 set children($id) {}
71 set nchildren($id) 0
72 }
73 if {$i == 1} {
74 set cid $id
75 lappend commits $id
76 set parents($id) {}
77 set cdate($id) $d
78 set nparents($id) 0
79 } else {
80 lappend parents($cid) $id
81 incr nparents($cid)
82 incr nchildren($id)
83 lappend children($id) $cid
84 }
85 }
86 incr i
87 }
88 }
Paul Mackerras9a40c502005-05-12 23:46:16 +000089 return 1
Paul Mackerras1db95b02005-05-09 04:08:39 +000090}
91
92proc readcommit {id} {
Paul Mackerrase5c2d852005-05-11 23:44:54 +000093 global commitinfo
Paul Mackerras1db95b02005-05-09 04:08:39 +000094 set inhdr 1
95 set comment {}
96 set headline {}
97 set auname {}
98 set audate {}
99 set comname {}
100 set comdate {}
101 foreach line [split [exec git-cat-file commit $id] "\n"] {
102 if {$inhdr} {
103 if {$line == {}} {
104 set inhdr 0
105 } else {
106 set tag [lindex $line 0]
107 if {$tag == "author"} {
108 set x [expr {[llength $line] - 2}]
109 set audate [lindex $line $x]
110 set auname [lrange $line 1 [expr {$x - 1}]]
111 } elseif {$tag == "committer"} {
112 set x [expr {[llength $line] - 2}]
113 set comdate [lindex $line $x]
114 set comname [lrange $line 1 [expr {$x - 1}]]
115 }
116 }
117 } else {
118 if {$comment == {}} {
119 set headline $line
120 } else {
121 append comment "\n"
122 }
123 append comment $line
124 }
125 }
126 if {$audate != {}} {
127 set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]
128 }
129 if {$comdate != {}} {
130 set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
131 }
Paul Mackerrase5c2d852005-05-11 23:44:54 +0000132 set commitinfo($id) [list $headline $auname $audate \
133 $comname $comdate $comment]
Paul Mackerras1db95b02005-05-09 04:08:39 +0000134}
135
136proc makewindow {} {
Paul Mackerrase5c2d852005-05-11 23:44:54 +0000137 global canv canv2 canv3 linespc charspc ctext cflist textfont
Paul Mackerras98f350e2005-05-15 05:56:51 +0000138 global sha1entry findtype findloc findstring
Paul Mackerras9a40c502005-05-12 23:46:16 +0000139
140 menu .bar
141 .bar add cascade -label "File" -menu .bar.file
142 menu .bar.file
143 .bar.file add command -label "Quit" -command "set stopped 1; destroy ."
144 menu .bar.help
145 .bar add cascade -label "Help" -menu .bar.help
146 .bar.help add command -label "About gitk" -command about
147 . configure -menu .bar
148
Paul Mackerras0327d272005-05-10 00:23:42 +0000149 panedwindow .ctop -orient vertical
Paul Mackerras98f350e2005-05-15 05:56:51 +0000150 frame .ctop.top
151 frame .ctop.top.bar
152 pack .ctop.top.bar -side bottom -fill x
153 set cscroll .ctop.top.csb
154 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
155 pack $cscroll -side right -fill y
156 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
157 pack .ctop.top.clist -side top -fill both -expand 1
158 .ctop add .ctop.top
159 set canv .ctop.top.clist.canv
Paul Mackerrase5c2d852005-05-11 23:44:54 +0000160 set height [expr 25 * $linespc + 4]
161 canvas $canv -height $height -width [expr 45 * $charspc] \
Paul Mackerrasb5721c72005-05-10 12:08:22 +0000162 -bg white -bd 0 \
163 -yscrollincr $linespc -yscrollcommand "$cscroll set"
Paul Mackerras98f350e2005-05-15 05:56:51 +0000164 .ctop.top.clist add $canv
165 set canv2 .ctop.top.clist.canv2
Paul Mackerrase5c2d852005-05-11 23:44:54 +0000166 canvas $canv2 -height $height -width [expr 30 * $charspc] \
Paul Mackerrasb5721c72005-05-10 12:08:22 +0000167 -bg white -bd 0 -yscrollincr $linespc
Paul Mackerras98f350e2005-05-15 05:56:51 +0000168 .ctop.top.clist add $canv2
169 set canv3 .ctop.top.clist.canv3
Paul Mackerrase5c2d852005-05-11 23:44:54 +0000170 canvas $canv3 -height $height -width [expr 15 * $charspc] \
Paul Mackerrasb5721c72005-05-10 12:08:22 +0000171 -bg white -bd 0 -yscrollincr $linespc
Paul Mackerras98f350e2005-05-15 05:56:51 +0000172 .ctop.top.clist add $canv3
173
174 set sha1entry .ctop.top.bar.sha1
175 label .ctop.top.bar.sha1label -text "SHA1 ID: "
176 pack .ctop.top.bar.sha1label -side left
177 entry $sha1entry -width 40 -font $textfont -state readonly
178 pack $sha1entry -side left -pady 2
179 button .ctop.top.bar.findbut -text "Find" -command dofind
180 pack .ctop.top.bar.findbut -side left
181 set findstring {}
182 entry .ctop.top.bar.findstring -width 30 -font $textfont \
183 -textvariable findstring
184 pack .ctop.top.bar.findstring -side left -expand 1 -fill x
185 set findtype Exact
186 tk_optionMenu .ctop.top.bar.findtype findtype Exact IgnCase Regexp
187 set findloc "All fields"
188 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
189 Comments Author Committer
190 pack .ctop.top.bar.findloc -side right
191 pack .ctop.top.bar.findtype -side right
Paul Mackerrasb5721c72005-05-10 12:08:22 +0000192
Paul Mackerras5ad588d2005-05-10 01:02:55 +0000193 panedwindow .ctop.cdet -orient horizontal
194 .ctop add .ctop.cdet
Paul Mackerrasd2610d12005-05-11 00:45:38 +0000195 frame .ctop.cdet.left
196 set ctext .ctop.cdet.left.ctext
Paul Mackerrase5c2d852005-05-11 23:44:54 +0000197 text $ctext -bg white -state disabled -font $textfont -height 32 \
Paul Mackerrasd2610d12005-05-11 00:45:38 +0000198 -yscrollcommand ".ctop.cdet.left.sb set"
199 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
200 pack .ctop.cdet.left.sb -side right -fill y
201 pack $ctext -side left -fill both -expand 1
202 .ctop.cdet add .ctop.cdet.left
203
Paul Mackerrase5c2d852005-05-11 23:44:54 +0000204 $ctext tag conf filesep -font [concat $textfont bold]
205 $ctext tag conf hunksep -back blue -fore white
206 $ctext tag conf d0 -back "#ff8080"
207 $ctext tag conf d1 -back green
208
Paul Mackerrasd2610d12005-05-11 00:45:38 +0000209 frame .ctop.cdet.right
210 set cflist .ctop.cdet.right.cfiles
Paul Mackerrase5c2d852005-05-11 23:44:54 +0000211 listbox $cflist -width 30 -bg white -selectmode extended \
Paul Mackerrasd2610d12005-05-11 00:45:38 +0000212 -yscrollcommand ".ctop.cdet.right.sb set"
213 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
214 pack .ctop.cdet.right.sb -side right -fill y
215 pack $cflist -side left -fill both -expand 1
216 .ctop.cdet add .ctop.cdet.right
217
Paul Mackerras0327d272005-05-10 00:23:42 +0000218 pack .ctop -side top -fill both -expand 1
Paul Mackerras1db95b02005-05-09 04:08:39 +0000219
Paul Mackerrasb5721c72005-05-10 12:08:22 +0000220 bindall <1> {selcanvline %x %y}
221 bindall <B1-Motion> {selcanvline %x %y}
222 bindall <ButtonRelease-4> "allcanvs yview scroll -5 u"
223 bindall <ButtonRelease-5> "allcanvs yview scroll 5 u"
224 bindall <2> "allcanvs scan mark 0 %y"
225 bindall <B2-Motion> "allcanvs scan dragto 0 %y"
Paul Mackerras5ad588d2005-05-10 01:02:55 +0000226 bind . <Key-Up> "selnextline -1"
227 bind . <Key-Down> "selnextline 1"
Paul Mackerrase5c2d852005-05-11 23:44:54 +0000228 bind . p "selnextline -1"
229 bind . n "selnextline 1"
230 bind . <Key-Prior> "allcanvs yview scroll -1 p"
231 bind . <Key-Next> "allcanvs yview scroll 1 p"
232 bind . <Key-Delete> "$ctext yview scroll -1 p"
233 bind . <Key-BackSpace> "$ctext yview scroll -1 p"
234 bind . <Key-space> "$ctext yview scroll 1 p"
235 bind . b "$ctext yview scroll -1 p"
236 bind . d "$ctext yview scroll 18 u"
237 bind . u "$ctext yview scroll -18 u"
Paul Mackerras1db95b02005-05-09 04:08:39 +0000238 bind . Q "set stopped 1; destroy ."
Paul Mackerras9a40c502005-05-12 23:46:16 +0000239 bind . <Control-q> "set stopped 1; destroy ."
Paul Mackerras98f350e2005-05-15 05:56:51 +0000240 bind . <Control-f> dofind
241 bind . <Control-g> findnext
242 bind . <Control-r> findprev
Paul Mackerrase5c2d852005-05-11 23:44:54 +0000243 bind $cflist <<ListboxSelect>> listboxsel
Paul Mackerras1db95b02005-05-09 04:08:39 +0000244}
245
Paul Mackerrasb5721c72005-05-10 12:08:22 +0000246proc allcanvs args {
247 global canv canv2 canv3
248 eval $canv $args
249 eval $canv2 $args
250 eval $canv3 $args
251}
252
253proc bindall {event action} {
254 global canv canv2 canv3
255 bind $canv $event $action
256 bind $canv2 $event $action
257 bind $canv3 $event $action
258}
259
Paul Mackerras9a40c502005-05-12 23:46:16 +0000260proc about {} {
261 set w .about
262 if {[winfo exists $w]} {
263 raise $w
264 return
265 }
266 toplevel $w
267 wm title $w "About gitk"
268 message $w.m -text {
269Gitk version 0.9
270
271Copyright © 2005 Paul Mackerras
272
273Use and redistribute under the terms of the GNU General Public License
274
Paul Mackerras98f350e2005-05-15 05:56:51 +0000275(CVS $Revision: 1.8 $)} \
Paul Mackerras9a40c502005-05-12 23:46:16 +0000276 -justify center -aspect 400
277 pack $w.m -side top -fill x -padx 20 -pady 20
278 button $w.ok -text Close -command "destroy $w"
279 pack $w.ok -side bottom
280}
281
Paul Mackerras1db95b02005-05-09 04:08:39 +0000282proc truncatetofit {str width font} {
283 if {[font measure $font $str] <= $width} {
284 return $str
285 }
286 set best 0
287 set bad [string length $str]
288 set tmp $str
289 while {$best < $bad - 1} {
290 set try [expr {int(($best + $bad) / 2)}]
291 set tmp "[string range $str 0 [expr $try-1]]..."
292 if {[font measure $font $tmp] <= $width} {
293 set best $try
294 } else {
295 set bad $try
296 }
297 }
298 return $tmp
299}
300
Paul Mackerrase5c2d852005-05-11 23:44:54 +0000301proc assigncolor {id} {
302 global commitinfo colormap commcolors colors nextcolor
303 global colorbycommitter
304 global parents nparents children nchildren
305 if [info exists colormap($id)] return
306 set ncolors [llength $colors]
307 if {$colorbycommitter} {
308 if {![info exists commitinfo($id)]} {
309 readcommit $id
310 }
311 set comm [lindex $commitinfo($id) 3]
312 if {![info exists commcolors($comm)]} {
313 set commcolors($comm) [lindex $colors $nextcolor]
314 if {[incr nextcolor] >= $ncolors} {
315 set nextcolor 0
316 }
317 }
318 set colormap($id) $commcolors($comm)
319 } else {
320 if {$nparents($id) == 1 && $nchildren($id) == 1} {
321 set child [lindex $children($id) 0]
322 if {[info exists colormap($child)]
323 && $nparents($child) == 1} {
324 set colormap($id) $colormap($child)
325 return
326 }
327 }
328 set badcolors {}
329 foreach child $children($id) {
330 if {[info exists colormap($child)]
331 && [lsearch -exact $badcolors $colormap($child)] < 0} {
332 lappend badcolors $colormap($child)
333 }
334 if {[info exists parents($child)]} {
335 foreach p $parents($child) {
336 if {[info exists colormap($p)]
337 && [lsearch -exact $badcolors $colormap($p)] < 0} {
338 lappend badcolors $colormap($p)
339 }
340 }
341 }
342 }
343 if {[llength $badcolors] >= $ncolors} {
344 set badcolors {}
345 }
346 for {set i 0} {$i <= $ncolors} {incr i} {
347 set c [lindex $colors $nextcolor]
348 if {[incr nextcolor] >= $ncolors} {
349 set nextcolor 0
350 }
351 if {[lsearch -exact $badcolors $c]} break
352 }
353 set colormap($id) $c
354 }
355}
356
Paul Mackerras98f350e2005-05-15 05:56:51 +0000357proc drawgraph {startlist} {
Paul Mackerras1db95b02005-05-09 04:08:39 +0000358 global parents children nparents nchildren commits
Paul Mackerrasb5721c72005-05-10 12:08:22 +0000359 global canv canv2 canv3 mainfont namefont canvx0 canvy0 canvy linespc
Paul Mackerras1db95b02005-05-09 04:08:39 +0000360 global datemode cdate
Paul Mackerrase5c2d852005-05-11 23:44:54 +0000361 global lineid linehtag linentag linedtag commitinfo
Paul Mackerras98f350e2005-05-15 05:56:51 +0000362 global nextcolor colormap numcommits
Paul Mackerras9a40c502005-05-12 23:46:16 +0000363 global stopped
Paul Mackerras1db95b02005-05-09 04:08:39 +0000364
Paul Mackerras1db95b02005-05-09 04:08:39 +0000365 set nextcolor 0
Paul Mackerras1db95b02005-05-09 04:08:39 +0000366 foreach id $commits {
367 set ncleft($id) $nchildren($id)
368 }
Paul Mackerras98f350e2005-05-15 05:56:51 +0000369 foreach id $startlist {
370 assigncolor $id
371 }
372 set todo $startlist
373 set level [expr [llength $todo] - 1]
Paul Mackerrasb5721c72005-05-10 12:08:22 +0000374 set y2 $canvy0
Paul Mackerras1db95b02005-05-09 04:08:39 +0000375 set nullentry -1
376 set lineno -1
Paul Mackerras98f350e2005-05-15 05:56:51 +0000377 set numcommits 0
Paul Mackerras1db95b02005-05-09 04:08:39 +0000378 while 1 {
Paul Mackerrasb5721c72005-05-10 12:08:22 +0000379 set canvy $y2
380 allcanvs conf -scrollregion [list 0 0 0 $canvy]
381 update
Paul Mackerras9a40c502005-05-12 23:46:16 +0000382 if {$stopped} return
Paul Mackerras98f350e2005-05-15 05:56:51 +0000383 incr numcommits
Paul Mackerras1db95b02005-05-09 04:08:39 +0000384 incr lineno
385 set nlines [llength $todo]
386 set id [lindex $todo $level]
387 set lineid($lineno) $id
Paul Mackerras0327d272005-05-10 00:23:42 +0000388 set actualparents {}
Paul Mackerras1db95b02005-05-09 04:08:39 +0000389 foreach p $parents($id) {
Paul Mackerras0327d272005-05-10 00:23:42 +0000390 if {[info exists ncleft($p)]} {
391 incr ncleft($p) -1
392 lappend actualparents $p
393 }
Paul Mackerras1db95b02005-05-09 04:08:39 +0000394 }
Paul Mackerrase5c2d852005-05-11 23:44:54 +0000395 if {![info exists commitinfo($id)]} {
Paul Mackerras0327d272005-05-10 00:23:42 +0000396 readcommit $id
397 }
Paul Mackerras1db95b02005-05-09 04:08:39 +0000398 set x [expr $canvx0 + $level * $linespc]
399 set y2 [expr $canvy + $linespc]
Paul Mackerras98f350e2005-05-15 05:56:51 +0000400 if {[info exists linestarty($level)] && $linestarty($level) < $canvy} {
Paul Mackerras1db95b02005-05-09 04:08:39 +0000401 set t [$canv create line $x $linestarty($level) $x $canvy \
402 -width 2 -fill $colormap($id)]
403 $canv lower $t
Paul Mackerras1db95b02005-05-09 04:08:39 +0000404 }
Paul Mackerras98f350e2005-05-15 05:56:51 +0000405 set linestarty($level) $canvy
Paul Mackerras1db95b02005-05-09 04:08:39 +0000406 set t [$canv create oval [expr $x - 4] [expr $canvy - 4] \
407 [expr $x + 3] [expr $canvy + 3] \
408 -fill blue -outline black -width 1]
409 $canv raise $t
410 set xt [expr $canvx0 + $nlines * $linespc]
Paul Mackerrase5c2d852005-05-11 23:44:54 +0000411 set headline [lindex $commitinfo($id) 0]
412 set name [lindex $commitinfo($id) 1]
413 set date [lindex $commitinfo($id) 2]
Paul Mackerras1db95b02005-05-09 04:08:39 +0000414 set linehtag($lineno) [$canv create text $xt $canvy -anchor w \
415 -text $headline -font $mainfont ]
Paul Mackerrasb5721c72005-05-10 12:08:22 +0000416 set linentag($lineno) [$canv2 create text 3 $canvy -anchor w \
Paul Mackerras1db95b02005-05-09 04:08:39 +0000417 -text $name -font $namefont]
Paul Mackerrasb5721c72005-05-10 12:08:22 +0000418 set linedtag($lineno) [$canv3 create text 3 $canvy -anchor w \
Paul Mackerras1db95b02005-05-09 04:08:39 +0000419 -text $date -font $mainfont]
Paul Mackerras0327d272005-05-10 00:23:42 +0000420 if {!$datemode && [llength $actualparents] == 1} {
421 set p [lindex $actualparents 0]
Paul Mackerras1db95b02005-05-09 04:08:39 +0000422 if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} {
Paul Mackerrase5c2d852005-05-11 23:44:54 +0000423 assigncolor $p
Paul Mackerras1db95b02005-05-09 04:08:39 +0000424 set todo [lreplace $todo $level $level $p]
Paul Mackerras1db95b02005-05-09 04:08:39 +0000425 continue
426 }
427 }
428
429 set oldtodo $todo
430 set oldlevel $level
431 set lines {}
432 for {set i 0} {$i < $nlines} {incr i} {
433 if {[lindex $todo $i] == {}} continue
Paul Mackerras98f350e2005-05-15 05:56:51 +0000434 if {[info exists linestarty($i)]} {
435 set oldstarty($i) $linestarty($i)
436 unset linestarty($i)
437 }
Paul Mackerras1db95b02005-05-09 04:08:39 +0000438 if {$i != $level} {
439 lappend lines [list $i [lindex $todo $i]]
440 }
441 }
Paul Mackerras1db95b02005-05-09 04:08:39 +0000442 if {$nullentry >= 0} {
443 set todo [lreplace $todo $nullentry $nullentry]
444 if {$nullentry < $level} {
445 incr level -1
446 }
447 }
448
Paul Mackerras1db95b02005-05-09 04:08:39 +0000449 set todo [lreplace $todo $level $level]
450 if {$nullentry > $level} {
451 incr nullentry -1
452 }
453 set i $level
Paul Mackerras0327d272005-05-10 00:23:42 +0000454 foreach p $actualparents {
Paul Mackerras1db95b02005-05-09 04:08:39 +0000455 set k [lsearch -exact $todo $p]
456 if {$k < 0} {
Paul Mackerrase5c2d852005-05-11 23:44:54 +0000457 assigncolor $p
Paul Mackerras1db95b02005-05-09 04:08:39 +0000458 set todo [linsert $todo $i $p]
459 if {$nullentry >= $i} {
460 incr nullentry
461 }
Paul Mackerras1db95b02005-05-09 04:08:39 +0000462 }
463 lappend lines [list $oldlevel $p]
464 }
465
466 # choose which one to do next time around
467 set todol [llength $todo]
468 set level -1
469 set latest {}
470 for {set k $todol} {[incr k -1] >= 0} {} {
471 set p [lindex $todo $k]
472 if {$p == {}} continue
473 if {$ncleft($p) == 0} {
474 if {$datemode} {
475 if {$latest == {} || $cdate($p) > $latest} {
476 set level $k
477 set latest $cdate($p)
478 }
479 } else {
480 set level $k
481 break
482 }
483 }
484 }
485 if {$level < 0} {
486 if {$todo != {}} {
487 puts "ERROR: none of the pending commits can be done yet:"
488 foreach p $todo {
489 puts " $p"
490 }
491 }
492 break
493 }
494
495 # If we are reducing, put in a null entry
496 if {$todol < $nlines} {
497 if {$nullentry >= 0} {
498 set i $nullentry
499 while {$i < $todol
500 && [lindex $oldtodo $i] == [lindex $todo $i]} {
501 incr i
502 }
503 } else {
504 set i $oldlevel
505 if {$level >= $i} {
506 incr i
507 }
508 }
509 if {$i >= $todol} {
510 set nullentry -1
511 } else {
512 set nullentry $i
513 set todo [linsert $todo $nullentry {}]
514 if {$level >= $i} {
515 incr level
516 }
517 }
518 } else {
519 set nullentry -1
520 }
521
522 foreach l $lines {
523 set i [lindex $l 0]
524 set dst [lindex $l 1]
525 set j [lsearch -exact $todo $dst]
526 if {$i == $j} {
Paul Mackerras98f350e2005-05-15 05:56:51 +0000527 if {[info exists oldstarty($i)]} {
528 set linestarty($i) $oldstarty($i)
529 }
Paul Mackerras1db95b02005-05-09 04:08:39 +0000530 continue
531 }
532 set xi [expr {$canvx0 + $i * $linespc}]
533 set xj [expr {$canvx0 + $j * $linespc}]
534 set coords {}
Paul Mackerras98f350e2005-05-15 05:56:51 +0000535 if {[info exists oldstarty($i)] && $oldstarty($i) < $canvy} {
Paul Mackerras1db95b02005-05-09 04:08:39 +0000536 lappend coords $xi $oldstarty($i)
537 }
538 lappend coords $xi $canvy
539 if {$j < $i - 1} {
540 lappend coords [expr $xj + $linespc] $canvy
541 } elseif {$j > $i + 1} {
542 lappend coords [expr $xj - $linespc] $canvy
543 }
544 lappend coords $xj $y2
545 set t [$canv create line $coords -width 2 -fill $colormap($dst)]
546 $canv lower $t
547 if {![info exists linestarty($j)]} {
548 set linestarty($j) $y2
549 }
550 }
Paul Mackerras1db95b02005-05-09 04:08:39 +0000551 }
552}
553
Paul Mackerras98f350e2005-05-15 05:56:51 +0000554proc dofind {} {
555 global findtype findloc findstring markedmatches commitinfo
556 global numcommits lineid linehtag linentag linedtag
557 global mainfont namefont canv canv2 canv3 selectedline
558 global matchinglines
559 unmarkmatches
560 set matchinglines {}
561 set fldtypes {Headline Author Date Committer CDate Comment}
562 if {$findtype == "IgnCase"} {
563 set fstr [string tolower $findstring]
564 } else {
565 set fstr $findstring
566 }
567 set mlen [string length $findstring]
568 if {$mlen == 0} return
569 if {![info exists selectedline]} {
570 set oldsel -1
571 } else {
572 set oldsel $selectedline
573 }
574 set didsel 0
575 for {set l 0} {$l < $numcommits} {incr l} {
576 set id $lineid($l)
577 set info $commitinfo($id)
578 set doesmatch 0
579 foreach f $info ty $fldtypes {
580 if {$findloc != "All fields" && $findloc != $ty} {
581 continue
582 }
583 if {$findtype == "Regexp"} {
584 set matches [regexp -indices -all -inline $fstr $f]
585 } else {
586 if {$findtype == "IgnCase"} {
587 set str [string tolower $f]
588 } else {
589 set str $f
590 }
591 set matches {}
592 set i 0
593 while {[set j [string first $fstr $str $i]] >= 0} {
594 lappend matches [list $j [expr $j+$mlen-1]]
595 set i [expr $j + $mlen]
596 }
597 }
598 if {$matches == {}} continue
599 set doesmatch 1
600 if {$ty == "Headline"} {
601 markmatches $canv $l $f $linehtag($l) $matches $mainfont
602 } elseif {$ty == "Author"} {
603 markmatches $canv2 $l $f $linentag($l) $matches $namefont
604 } elseif {$ty == "Date"} {
605 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
606 }
607 }
608 if {$doesmatch} {
609 lappend matchinglines $l
610 if {!$didsel && $l > $oldsel} {
611 selectline $l
612 set didsel 1
613 }
614 }
615 }
616 if {$matchinglines == {}} {
617 bell
618 } elseif {!$didsel} {
619 selectline [lindex $matchinglines 0]
620 }
621}
622
623proc findnext {} {
624 global matchinglines selectedline
625 if {![info exists matchinglines]} {
626 dofind
627 return
628 }
629 if {![info exists selectedline]} return
630 foreach l $matchinglines {
631 if {$l > $selectedline} {
632 selectline $l
633 return
634 }
635 }
636 bell
637}
638
639proc findprev {} {
640 global matchinglines selectedline
641 if {![info exists matchinglines]} {
642 dofind
643 return
644 }
645 if {![info exists selectedline]} return
646 set prev {}
647 foreach l $matchinglines {
648 if {$l >= $selectedline} break
649 set prev $l
650 }
651 if {$prev != {}} {
652 selectline $prev
653 } else {
654 bell
655 }
656}
657
658proc markmatches {canv l str tag matches font} {
659 set bbox [$canv bbox $tag]
660 set x0 [lindex $bbox 0]
661 set y0 [lindex $bbox 1]
662 set y1 [lindex $bbox 3]
663 foreach match $matches {
664 set start [lindex $match 0]
665 set end [lindex $match 1]
666 if {$start > $end} continue
667 set xoff [font measure $font [string range $str 0 [expr $start-1]]]
668 set xlen [font measure $font [string range $str 0 [expr $end]]]
669 set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
670 -outline {} -tags matches -fill yellow]
671 $canv lower $t
672 }
673}
674
675proc unmarkmatches {} {
676 global matchinglines
677 allcanvs delete matches
678 catch {unset matchinglines}
679}
680
Paul Mackerras1db95b02005-05-09 04:08:39 +0000681proc selcanvline {x y} {
682 global canv canvy0 ctext linespc selectedline
Paul Mackerrase5c2d852005-05-11 23:44:54 +0000683 global lineid linehtag linentag linedtag
Paul Mackerras1db95b02005-05-09 04:08:39 +0000684 set ymax [lindex [$canv cget -scrollregion] 3]
685 set yfrac [lindex [$canv yview] 0]
686 set y [expr {$y + $yfrac * $ymax}]
687 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
688 if {$l < 0} {
689 set l 0
690 }
691 if {[info exists selectedline] && $selectedline == $l} return
Paul Mackerras98f350e2005-05-15 05:56:51 +0000692 unmarkmatches
Paul Mackerras5ad588d2005-05-10 01:02:55 +0000693 selectline $l
694}
695
696proc selectline {l} {
Paul Mackerrasd2610d12005-05-11 00:45:38 +0000697 global canv canv2 canv3 ctext commitinfo selectedline
698 global lineid linehtag linentag linedtag
699 global canvy canvy0 linespc nparents treepending
Paul Mackerras98f350e2005-05-15 05:56:51 +0000700 global cflist treediffs currentid sha1entry
Paul Mackerras1db95b02005-05-09 04:08:39 +0000701 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
Paul Mackerrasd2610d12005-05-11 00:45:38 +0000702 $canv delete secsel
703 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
704 -tags secsel -fill [$canv cget -selectbackground]]
705 $canv lower $t
706 $canv2 delete secsel
707 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
708 -tags secsel -fill [$canv2 cget -selectbackground]]
709 $canv2 lower $t
710 $canv3 delete secsel
711 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
712 -tags secsel -fill [$canv3 cget -selectbackground]]
713 $canv3 lower $t
Paul Mackerras5ad588d2005-05-10 01:02:55 +0000714 set y [expr {$canvy0 + $l * $linespc}]
715 set ytop [expr {($y - $linespc / 2.0) / $canvy}]
716 set ybot [expr {($y + $linespc / 2.0) / $canvy}]
717 set wnow [$canv yview]
718 if {$ytop < [lindex $wnow 0]} {
Paul Mackerrasb5721c72005-05-10 12:08:22 +0000719 allcanvs yview moveto $ytop
Paul Mackerras5ad588d2005-05-10 01:02:55 +0000720 } elseif {$ybot > [lindex $wnow 1]} {
721 set wh [expr {[lindex $wnow 1] - [lindex $wnow 0]}]
Paul Mackerrasb5721c72005-05-10 12:08:22 +0000722 allcanvs yview moveto [expr {$ybot - $wh}]
Paul Mackerras5ad588d2005-05-10 01:02:55 +0000723 }
724 set selectedline $l
725
Paul Mackerras1db95b02005-05-09 04:08:39 +0000726 set id $lineid($l)
Paul Mackerras98f350e2005-05-15 05:56:51 +0000727 $sha1entry conf -state normal
728 $sha1entry delete 0 end
729 $sha1entry insert 0 $id
730 $sha1entry selection from 0
731 $sha1entry selection to end
732 $sha1entry conf -state readonly
733
Paul Mackerras5ad588d2005-05-10 01:02:55 +0000734 $ctext conf -state normal
Paul Mackerras1db95b02005-05-09 04:08:39 +0000735 $ctext delete 0.0 end
736 set info $commitinfo($id)
Paul Mackerrasd2610d12005-05-11 00:45:38 +0000737 $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n"
738 $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n"
Paul Mackerras1db95b02005-05-09 04:08:39 +0000739 $ctext insert end "\n"
Paul Mackerrase5c2d852005-05-11 23:44:54 +0000740 $ctext insert end [lindex $info 5]
741 $ctext insert end "\n"
742 $ctext tag delete Comments
Paul Mackerras5ad588d2005-05-10 01:02:55 +0000743 $ctext conf -state disabled
744
745 $cflist delete 0 end
Paul Mackerrasd2610d12005-05-11 00:45:38 +0000746 set currentid $id
Paul Mackerras5ad588d2005-05-10 01:02:55 +0000747 if {$nparents($id) == 1} {
748 if {![info exists treediffs($id)]} {
Paul Mackerrasd2610d12005-05-11 00:45:38 +0000749 if {![info exists treepending]} {
750 gettreediffs $id
751 }
752 } else {
753 addtocflist $id
Paul Mackerras5ad588d2005-05-10 01:02:55 +0000754 }
755 }
Paul Mackerrase5c2d852005-05-11 23:44:54 +0000756}
Paul Mackerras5ad588d2005-05-10 01:02:55 +0000757
Paul Mackerrase5c2d852005-05-11 23:44:54 +0000758proc selnextline {dir} {
759 global selectedline
760 if {![info exists selectedline]} return
761 set l [expr $selectedline + $dir]
Paul Mackerras98f350e2005-05-15 05:56:51 +0000762 unmarkmatches
Paul Mackerrase5c2d852005-05-11 23:44:54 +0000763 selectline $l
Paul Mackerras5ad588d2005-05-10 01:02:55 +0000764}
765
Paul Mackerrasd2610d12005-05-11 00:45:38 +0000766proc addtocflist {id} {
767 global currentid treediffs cflist treepending
768 if {$id != $currentid} {
769 gettreediffs $currentid
770 return
771 }
Paul Mackerrase5c2d852005-05-11 23:44:54 +0000772 $cflist insert end "All files"
Paul Mackerrasd2610d12005-05-11 00:45:38 +0000773 foreach f $treediffs($currentid) {
774 $cflist insert end $f
775 }
Paul Mackerrase5c2d852005-05-11 23:44:54 +0000776 getblobdiffs $id
Paul Mackerrasd2610d12005-05-11 00:45:38 +0000777}
778
779proc gettreediffs {id} {
780 global treediffs parents treepending
781 set treepending $id
782 set treediffs($id) {}
783 set p [lindex $parents($id) 0]
784 if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
785 fconfigure $gdtf -blocking 0
786 fileevent $gdtf readable "gettreediffline $gdtf $id"
787}
788
789proc gettreediffline {gdtf id} {
790 global treediffs treepending
791 set n [gets $gdtf line]
792 if {$n < 0} {
793 if {![eof $gdtf]} return
794 close $gdtf
795 unset treepending
796 addtocflist $id
797 return
798 }
799 set type [lindex $line 1]
800 set file [lindex $line 3]
801 if {$type == "blob"} {
802 lappend treediffs($id) $file
803 }
804}
805
Paul Mackerrase5c2d852005-05-11 23:44:54 +0000806proc getblobdiffs {id} {
807 global parents diffopts blobdifffd env curdifftag curtagstart
808 set p [lindex $parents($id) 0]
809 set env(GIT_DIFF_OPTS) $diffopts
810 if [catch {set bdf [open "|git-diff-tree -r -p $p $id" r]} err] {
811 puts "error getting diffs: $err"
812 return
813 }
814 fconfigure $bdf -blocking 0
815 set blobdifffd($id) $bdf
816 set curdifftag Comments
817 set curtagstart 0.0
818 fileevent $bdf readable "getblobdiffline $bdf $id"
819}
820
821proc getblobdiffline {bdf id} {
822 global currentid blobdifffd ctext curdifftag curtagstart
823 set n [gets $bdf line]
824 if {$n < 0} {
825 if {[eof $bdf]} {
826 close $bdf
827 if {$id == $currentid && $bdf == $blobdifffd($id)} {
828 $ctext tag add $curdifftag $curtagstart end
829 }
830 }
831 return
832 }
833 if {$id != $currentid || $bdf != $blobdifffd($id)} {
834 return
835 }
836 $ctext conf -state normal
837 if {[regexp {^---[ \t]+([^/])+/(.*)} $line match s1 fname]} {
838 # start of a new file
839 $ctext insert end "\n"
840 $ctext tag add $curdifftag $curtagstart end
841 set curtagstart [$ctext index "end - 1c"]
842 set curdifftag "f:$fname"
843 $ctext tag delete $curdifftag
844 set l [expr {(78 - [string length $fname]) / 2}]
845 set pad [string range "----------------------------------------" 1 $l]
846 $ctext insert end "$pad $fname $pad\n" filesep
847 } elseif {[string range $line 0 2] == "+++"} {
848 # no need to do anything with this
849 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
850 $line match f1l f1c f2l f2c rest]} {
851 $ctext insert end "\t" hunksep
852 $ctext insert end " $f1l " d0 " $f2l " d1
853 $ctext insert end " $rest \n" hunksep
854 } else {
855 set x [string range $line 0 0]
856 if {$x == "-" || $x == "+"} {
857 set tag [expr {$x == "+"}]
858 set line [string range $line 1 end]
859 $ctext insert end "$line\n" d$tag
860 } elseif {$x == " "} {
861 set line [string range $line 1 end]
862 $ctext insert end "$line\n"
863 } else {
864 # Something else we don't recognize
865 if {$curdifftag != "Comments"} {
866 $ctext insert end "\n"
867 $ctext tag add $curdifftag $curtagstart end
868 set curtagstart [$ctext index "end - 1c"]
869 set curdifftag Comments
870 }
871 $ctext insert end "$line\n" filesep
872 }
873 }
874 $ctext conf -state disabled
875}
876
877proc listboxsel {} {
878 global ctext cflist currentid treediffs
Paul Mackerras9a40c502005-05-12 23:46:16 +0000879 if {![info exists currentid]} return
Paul Mackerrase5c2d852005-05-11 23:44:54 +0000880 set sel [$cflist curselection]
881 if {$sel == {} || [lsearch -exact $sel 0] >= 0} {
882 # show everything
883 $ctext tag conf Comments -elide 0
884 foreach f $treediffs($currentid) {
885 $ctext tag conf "f:$f" -elide 0
886 }
887 } else {
888 # just show selected files
889 $ctext tag conf Comments -elide 1
890 set i 1
891 foreach f $treediffs($currentid) {
892 set elide [expr {[lsearch -exact $sel $i] < 0}]
893 $ctext tag conf "f:$f" -elide $elide
894 incr i
895 }
896 }
Paul Mackerras1db95b02005-05-09 04:08:39 +0000897}
898
Paul Mackerras9a40c502005-05-12 23:46:16 +0000899if {![getcommits $revtreeargs]} {
900 exit 1
901}
Paul Mackerras1db95b02005-05-09 04:08:39 +0000902
Paul Mackerras1db95b02005-05-09 04:08:39 +0000903set linespc [font metrics $mainfont -linespace]
904set charspc [font measure $mainfont "m"]
905
906set canvy0 [expr 3 + 0.5 * $linespc]
907set canvx0 [expr 3 + 0.5 * $linespc]
908set namex [expr 45 * $charspc]
909set datex [expr 75 * $charspc]
910
Paul Mackerras9a40c502005-05-12 23:46:16 +0000911set stopped 0
Paul Mackerras1db95b02005-05-09 04:08:39 +0000912makewindow
913
914set start {}
915foreach id $commits {
916 if {$nchildren($id) == 0} {
Paul Mackerras98f350e2005-05-15 05:56:51 +0000917 lappend start $id
Paul Mackerras1db95b02005-05-09 04:08:39 +0000918 }
919}
920if {$start != {}} {
921 drawgraph $start
922}