gitk 24.3 KB
Newer Older
1 2 3 4 5 6 7 8 9
#!/bin/sh
# Tcl ignores the next line -*- tcl -*- \
exec wish "$0" -- "${1+$@}"

# Copyright (C) 2005 Paul Mackerras.  All rights reserved.
# This program is free software; it may be used, copied, modified
# and distributed under the terms of the GNU General Public Licence,
# either version 2, or (at your option) any later version.

10
# CVS $Revision: 1.8 $
P
Paul Mackerras 已提交
11

12 13 14
set datemode 0
set boldnames 0
set revtreeargs {}
15
set diffopts "-U 5 -p"
16

17 18
set mainfont {Helvetica 9}
set namefont $mainfont
19
set textfont {Courier 9}
20 21 22
if {$boldnames} {
    lappend namefont bold
}
23 24 25 26

set colors {green red blue magenta darkgrey brown orange}
set colorbycommitter false

27 28
catch {source ~/.gitk}

29 30 31 32
foreach arg $argv {
    switch -regexp -- $arg {
	"^$" { }
	"^-b" { set boldnames 1 }
33 34
	"^-c" { set colorbycommitter 1 }
	"^-d" { set datemode 1 }
35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50
	"^-.*" {
	    puts stderr "unrecognized option $arg"
	    exit 1
	}
	default {
	    lappend revtreeargs $arg
	}
    }
}

proc getcommits {rargs} {
    global commits parents cdate nparents children nchildren
    if {$rargs == {}} {
	set rargs HEAD
    }
    set commits {}
51 52 53 54 55 56 57 58 59 60 61
    if [catch {set clist [eval exec git-rev-tree $rargs]} err] {
	if {[string range $err 0 4] == "usage"} {
	    puts stderr "Error reading commits: bad arguments to git-rev-tree"
	    puts stderr "Note: arguments to gitk are passed to git-rev-tree"
	    puts stderr "      to allow selection of commits to be displayed"
	} else {
	    puts stderr "Error reading commits: $err"
	}
	return 0
    }
    foreach c [split $clist "\n"] {
62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88
	set i 0
	set cid {}
	foreach f $c {
	    if {$i == 0} {
		set d $f
	    } else {
		set id [lindex [split $f :] 0]
		if {![info exists nchildren($id)]} {
		    set children($id) {}
		    set nchildren($id) 0
		}
		if {$i == 1} {
		    set cid $id
		    lappend commits $id
		    set parents($id) {}
		    set cdate($id) $d
		    set nparents($id) 0
		} else {
		    lappend parents($cid) $id
		    incr nparents($cid)
		    incr nchildren($id)
		    lappend children($id) $cid
		}
	    }
	    incr i
	}
    }
89
    return 1
90 91 92
}

proc readcommit {id} {
93
    global commitinfo
94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131
    set inhdr 1
    set comment {}
    set headline {}
    set auname {}
    set audate {}
    set comname {}
    set comdate {}
    foreach line [split [exec git-cat-file commit $id] "\n"] {
	if {$inhdr} {
	    if {$line == {}} {
		set inhdr 0
	    } else {
		set tag [lindex $line 0]
		if {$tag == "author"} {
		    set x [expr {[llength $line] - 2}]
		    set audate [lindex $line $x]
		    set auname [lrange $line 1 [expr {$x - 1}]]
		} elseif {$tag == "committer"} {
		    set x [expr {[llength $line] - 2}]
		    set comdate [lindex $line $x]
		    set comname [lrange $line 1 [expr {$x - 1}]]
		}
	    }
	} else {
	    if {$comment == {}} {
		set headline $line
	    } else {
		append comment "\n"
	    }
	    append comment $line
	}
    }
    if {$audate != {}} {
	set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]
    }
    if {$comdate != {}} {
	set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
    }
132 133
    set commitinfo($id) [list $headline $auname $audate \
			     $comname $comdate $comment]
134 135 136
}

proc makewindow {} {
137
    global canv canv2 canv3 linespc charspc ctext cflist textfont
138
    global sha1entry findtype findloc findstring
139 140 141 142 143 144 145 146 147 148

    menu .bar
    .bar add cascade -label "File" -menu .bar.file
    menu .bar.file
    .bar.file add command -label "Quit" -command "set stopped 1; destroy ."
    menu .bar.help
    .bar add cascade -label "Help" -menu .bar.help
    .bar.help add command -label "About gitk" -command about
    . configure -menu .bar

P
Paul Mackerras 已提交
149
    panedwindow .ctop -orient vertical
150 151 152 153 154 155 156 157 158 159
    frame .ctop.top
    frame .ctop.top.bar
    pack .ctop.top.bar -side bottom -fill x
    set cscroll .ctop.top.csb
    scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
    pack $cscroll -side right -fill y
    panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
    pack .ctop.top.clist -side top -fill both -expand 1
    .ctop add .ctop.top
    set canv .ctop.top.clist.canv
160 161
    set height [expr 25 * $linespc + 4]
    canvas $canv -height $height -width [expr 45 * $charspc] \
162 163
	-bg white -bd 0 \
	-yscrollincr $linespc -yscrollcommand "$cscroll set"
164 165
    .ctop.top.clist add $canv
    set canv2 .ctop.top.clist.canv2
166
    canvas $canv2 -height $height -width [expr 30 * $charspc] \
167
	-bg white -bd 0 -yscrollincr $linespc
168 169
    .ctop.top.clist add $canv2
    set canv3 .ctop.top.clist.canv3
170
    canvas $canv3 -height $height -width [expr 15 * $charspc] \
171
	-bg white -bd 0 -yscrollincr $linespc
172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191
    .ctop.top.clist add $canv3

    set sha1entry .ctop.top.bar.sha1
    label .ctop.top.bar.sha1label -text "SHA1 ID: "
    pack .ctop.top.bar.sha1label -side left
    entry $sha1entry -width 40 -font $textfont -state readonly
    pack $sha1entry -side left -pady 2
    button .ctop.top.bar.findbut -text "Find" -command dofind
    pack .ctop.top.bar.findbut -side left
    set findstring {}
    entry .ctop.top.bar.findstring -width 30 -font $textfont \
	-textvariable findstring
    pack .ctop.top.bar.findstring -side left -expand 1 -fill x
    set findtype Exact
    tk_optionMenu .ctop.top.bar.findtype findtype Exact IgnCase Regexp
    set findloc "All fields"
    tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
	Comments Author Committer
    pack .ctop.top.bar.findloc -side right
    pack .ctop.top.bar.findtype -side right
192

193 194
    panedwindow .ctop.cdet -orient horizontal
    .ctop add .ctop.cdet
195 196
    frame .ctop.cdet.left
    set ctext .ctop.cdet.left.ctext
197
    text $ctext -bg white -state disabled -font $textfont -height 32 \
198 199 200 201 202 203
	-yscrollcommand ".ctop.cdet.left.sb set"
    scrollbar .ctop.cdet.left.sb -command "$ctext yview"
    pack .ctop.cdet.left.sb -side right -fill y
    pack $ctext -side left -fill both -expand 1
    .ctop.cdet add .ctop.cdet.left

204 205 206 207 208
    $ctext tag conf filesep -font [concat $textfont bold]
    $ctext tag conf hunksep -back blue -fore white
    $ctext tag conf d0 -back "#ff8080"
    $ctext tag conf d1 -back green

209 210
    frame .ctop.cdet.right
    set cflist .ctop.cdet.right.cfiles
211
    listbox $cflist -width 30 -bg white -selectmode extended \
212 213 214 215 216 217
	-yscrollcommand ".ctop.cdet.right.sb set"
    scrollbar .ctop.cdet.right.sb -command "$cflist yview"
    pack .ctop.cdet.right.sb -side right -fill y
    pack $cflist -side left -fill both -expand 1
    .ctop.cdet add .ctop.cdet.right

P
Paul Mackerras 已提交
218
    pack .ctop -side top -fill both -expand 1
219

220 221 222 223 224 225
    bindall <1> {selcanvline %x %y}
    bindall <B1-Motion> {selcanvline %x %y}
    bindall <ButtonRelease-4> "allcanvs yview scroll -5 u"
    bindall <ButtonRelease-5> "allcanvs yview scroll 5 u"
    bindall <2> "allcanvs scan mark 0 %y"
    bindall <B2-Motion> "allcanvs scan dragto 0 %y"
226 227
    bind . <Key-Up> "selnextline -1"
    bind . <Key-Down> "selnextline 1"
228 229 230 231 232 233 234 235 236 237
    bind . p "selnextline -1"
    bind . n "selnextline 1"
    bind . <Key-Prior> "allcanvs yview scroll -1 p"
    bind . <Key-Next> "allcanvs yview scroll 1 p"
    bind . <Key-Delete> "$ctext yview scroll -1 p"
    bind . <Key-BackSpace> "$ctext yview scroll -1 p"
    bind . <Key-space> "$ctext yview scroll 1 p"
    bind . b "$ctext yview scroll -1 p"
    bind . d "$ctext yview scroll 18 u"
    bind . u "$ctext yview scroll -18 u"
238
    bind . Q "set stopped 1; destroy ."
239
    bind . <Control-q> "set stopped 1; destroy ."
240 241 242
    bind . <Control-f> dofind
    bind . <Control-g> findnext
    bind . <Control-r> findprev
243
    bind $cflist <<ListboxSelect>> listboxsel
244 245
}

246 247 248 249 250 251 252 253 254 255 256 257 258 259
proc allcanvs args {
    global canv canv2 canv3
    eval $canv $args
    eval $canv2 $args
    eval $canv3 $args
}

proc bindall {event action} {
    global canv canv2 canv3
    bind $canv $event $action
    bind $canv2 $event $action
    bind $canv3 $event $action
}

260 261 262 263 264 265 266 267 268 269 270 271 272 273 274
proc about {} {
    set w .about
    if {[winfo exists $w]} {
	raise $w
	return
    }
    toplevel $w
    wm title $w "About gitk"
    message $w.m -text {
Gitk version 0.9

Copyright  2005 Paul Mackerras

Use and redistribute under the terms of the GNU General Public License

275
(CVS $Revision: 1.8 $)} \
276 277 278 279 280 281
	    -justify center -aspect 400
    pack $w.m -side top -fill x -padx 20 -pady 20
    button $w.ok -text Close -command "destroy $w"
    pack $w.ok -side bottom
}

282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300
proc truncatetofit {str width font} {
    if {[font measure $font $str] <= $width} {
	return $str
    }
    set best 0
    set bad [string length $str]
    set tmp $str
    while {$best < $bad - 1} {
	set try [expr {int(($best + $bad) / 2)}]
	set tmp "[string range $str 0 [expr $try-1]]..."
	if {[font measure $font $tmp] <= $width} {
	    set best $try
	} else {
	    set bad $try
	}
    }
    return $tmp
}

301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356
proc assigncolor {id} {
    global commitinfo colormap commcolors colors nextcolor
    global colorbycommitter
    global parents nparents children nchildren
    if [info exists colormap($id)] return
    set ncolors [llength $colors]
    if {$colorbycommitter} {
	if {![info exists commitinfo($id)]} {
	    readcommit $id
	}
	set comm [lindex $commitinfo($id) 3]
	if {![info exists commcolors($comm)]} {
	    set commcolors($comm) [lindex $colors $nextcolor]
	    if {[incr nextcolor] >= $ncolors} {
		set nextcolor 0
	    }
	}
	set colormap($id) $commcolors($comm)
    } else {
	if {$nparents($id) == 1 && $nchildren($id) == 1} {
	    set child [lindex $children($id) 0]
	    if {[info exists colormap($child)]
		&& $nparents($child) == 1} {
		set colormap($id) $colormap($child)
		return
	    }
	}
	set badcolors {}
	foreach child $children($id) {
	    if {[info exists colormap($child)]
		&& [lsearch -exact $badcolors $colormap($child)] < 0} {
		lappend badcolors $colormap($child)
	    }
	    if {[info exists parents($child)]} {
		foreach p $parents($child) {
		    if {[info exists colormap($p)]
			&& [lsearch -exact $badcolors $colormap($p)] < 0} {
			lappend badcolors $colormap($p)
		    }
		}
	    }
	}
	if {[llength $badcolors] >= $ncolors} {
	    set badcolors {}
	}
	for {set i 0} {$i <= $ncolors} {incr i} {
	    set c [lindex $colors $nextcolor]
	    if {[incr nextcolor] >= $ncolors} {
		set nextcolor 0
	    }
	    if {[lsearch -exact $badcolors $c]} break
	}
	set colormap($id) $c
    }
}

357
proc drawgraph {startlist} {
358
    global parents children nparents nchildren commits
359
    global canv canv2 canv3 mainfont namefont canvx0 canvy0 canvy linespc
360
    global datemode cdate
361
    global lineid linehtag linentag linedtag commitinfo
362
    global nextcolor colormap numcommits
363
    global stopped
364 365 366 367 368

    set nextcolor 0
    foreach id $commits {
	set ncleft($id) $nchildren($id)
    }
369 370 371 372 373
    foreach id $startlist {
	assigncolor $id
    }
    set todo $startlist
    set level [expr [llength $todo] - 1]
374
    set y2 $canvy0
375 376
    set nullentry -1
    set lineno -1
377
    set numcommits 0
378
    while 1 {
379 380 381
	set canvy $y2
	allcanvs conf -scrollregion [list 0 0 0 $canvy]
	update
382
	if {$stopped} return
383
	incr numcommits
384 385 386 387
	incr lineno
	set nlines [llength $todo]
	set id [lindex $todo $level]
	set lineid($lineno) $id
P
Paul Mackerras 已提交
388
	set actualparents {}
389
	foreach p $parents($id) {
P
Paul Mackerras 已提交
390 391 392 393 394
	    if {[info exists ncleft($p)]} {
		incr ncleft($p) -1
		lappend actualparents $p
	    }
	}
395
	if {![info exists commitinfo($id)]} {
P
Paul Mackerras 已提交
396
	    readcommit $id
397 398 399
	}
	set x [expr $canvx0 + $level * $linespc]
	set y2 [expr $canvy + $linespc]
400
	if {[info exists linestarty($level)] && $linestarty($level) < $canvy} {
401 402 403 404
	    set t [$canv create line $x $linestarty($level) $x $canvy \
		       -width 2 -fill $colormap($id)]
	    $canv lower $t
	}
405
	set linestarty($level) $canvy
406 407 408 409 410
	set t [$canv create oval [expr $x - 4] [expr $canvy - 4] \
		   [expr $x + 3] [expr $canvy + 3] \
		   -fill blue -outline black -width 1]
	$canv raise $t
	set xt [expr $canvx0 + $nlines * $linespc]
411 412 413
	set headline [lindex $commitinfo($id) 0]
	set name [lindex $commitinfo($id) 1]
	set date [lindex $commitinfo($id) 2]
414 415
	set linehtag($lineno) [$canv create text $xt $canvy -anchor w \
				   -text $headline -font $mainfont ]
416
	set linentag($lineno) [$canv2 create text 3 $canvy -anchor w \
417
				   -text $name -font $namefont]
418
	set linedtag($lineno) [$canv3 create text 3 $canvy -anchor w \
419
				 -text $date -font $mainfont]
P
Paul Mackerras 已提交
420 421
	if {!$datemode && [llength $actualparents] == 1} {
	    set p [lindex $actualparents 0]
422
	    if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} {
423
		assigncolor $p
424 425 426 427 428 429 430 431 432 433
		set todo [lreplace $todo $level $level $p]
		continue
	    }
	}

	set oldtodo $todo
	set oldlevel $level
	set lines {}
	for {set i 0} {$i < $nlines} {incr i} {
	    if {[lindex $todo $i] == {}} continue
434 435 436 437
	    if {[info exists linestarty($i)]} {
		set oldstarty($i) $linestarty($i)
		unset linestarty($i)
	    }
438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453
	    if {$i != $level} {
		lappend lines [list $i [lindex $todo $i]]
	    }
	}
	if {$nullentry >= 0} {
	    set todo [lreplace $todo $nullentry $nullentry]
	    if {$nullentry < $level} {
		incr level -1
	    }
	}

	set todo [lreplace $todo $level $level]
	if {$nullentry > $level} {
	    incr nullentry -1
	}
	set i $level
P
Paul Mackerras 已提交
454
	foreach p $actualparents {
455 456
	    set k [lsearch -exact $todo $p]
	    if {$k < 0} {
457
		assigncolor $p
458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526
		set todo [linsert $todo $i $p]
		if {$nullentry >= $i} {
		    incr nullentry
		}
	    }
	    lappend lines [list $oldlevel $p]
	}

	# choose which one to do next time around
	set todol [llength $todo]
	set level -1
	set latest {}
	for {set k $todol} {[incr k -1] >= 0} {} {
	    set p [lindex $todo $k]
	    if {$p == {}} continue
	    if {$ncleft($p) == 0} {
		if {$datemode} {
		    if {$latest == {} || $cdate($p) > $latest} {
			set level $k
			set latest $cdate($p)
		    }
		} else {
		    set level $k
		    break
		}
	    }
	}
	if {$level < 0} {
	    if {$todo != {}} {
		puts "ERROR: none of the pending commits can be done yet:"
		foreach p $todo {
		    puts "  $p"
		}
	    }
	    break
	}

	# If we are reducing, put in a null entry
	if {$todol < $nlines} {
	    if {$nullentry >= 0} {
		set i $nullentry
		while {$i < $todol
		       && [lindex $oldtodo $i] == [lindex $todo $i]} {
		    incr i
		}
	    } else {
		set i $oldlevel
		if {$level >= $i} {
		    incr i
		}
	    }
	    if {$i >= $todol} {
		set nullentry -1
	    } else {
		set nullentry $i
		set todo [linsert $todo $nullentry {}]
		if {$level >= $i} {
		    incr level
		}
	    }
	} else {
	    set nullentry -1
	}

	foreach l $lines {
	    set i [lindex $l 0]
	    set dst [lindex $l 1]
	    set j [lsearch -exact $todo $dst]
	    if {$i == $j} {
527 528 529
		if {[info exists oldstarty($i)]} {
		    set linestarty($i) $oldstarty($i)
		}
530 531 532 533 534
		continue
	    }
	    set xi [expr {$canvx0 + $i * $linespc}]
	    set xj [expr {$canvx0 + $j * $linespc}]
	    set coords {}
535
	    if {[info exists oldstarty($i)] && $oldstarty($i) < $canvy} {
536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553
		lappend coords $xi $oldstarty($i)
	    }
	    lappend coords $xi $canvy
	    if {$j < $i - 1} {
		lappend coords [expr $xj + $linespc] $canvy
	    } elseif {$j > $i + 1} {
		lappend coords [expr $xj - $linespc] $canvy
	    }
	    lappend coords $xj $y2
	    set t [$canv create line $coords -width 2 -fill $colormap($dst)]
	    $canv lower $t
	    if {![info exists linestarty($j)]} {
		set linestarty($j) $y2
	    }
	}
    }
}

554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680
proc dofind {} {
    global findtype findloc findstring markedmatches commitinfo
    global numcommits lineid linehtag linentag linedtag
    global mainfont namefont canv canv2 canv3 selectedline
    global matchinglines
    unmarkmatches
    set matchinglines {}
    set fldtypes {Headline Author Date Committer CDate Comment}
    if {$findtype == "IgnCase"} {
	set fstr [string tolower $findstring]
    } else {
	set fstr $findstring
    }
    set mlen [string length $findstring]
    if {$mlen == 0} return
    if {![info exists selectedline]} {
	set oldsel -1
    } else {
	set oldsel $selectedline
    }
    set didsel 0
    for {set l 0} {$l < $numcommits} {incr l} {
	set id $lineid($l)
	set info $commitinfo($id)
	set doesmatch 0
	foreach f $info ty $fldtypes {
	    if {$findloc != "All fields" && $findloc != $ty} {
		continue
	    }
	    if {$findtype == "Regexp"} {
		set matches [regexp -indices -all -inline $fstr $f]
	    } else {
		if {$findtype == "IgnCase"} {
		    set str [string tolower $f]
		} else {
		    set str $f
		}
		set matches {}
		set i 0
		while {[set j [string first $fstr $str $i]] >= 0} {
		    lappend matches [list $j [expr $j+$mlen-1]]
		    set i [expr $j + $mlen]
		}
	    }
	    if {$matches == {}} continue
	    set doesmatch 1
	    if {$ty == "Headline"} {
		markmatches $canv $l $f $linehtag($l) $matches $mainfont
	    } elseif {$ty == "Author"} {
		markmatches $canv2 $l $f $linentag($l) $matches $namefont
	    } elseif {$ty == "Date"} {
		markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
	    }
	}
	if {$doesmatch} {
	    lappend matchinglines $l
	    if {!$didsel && $l > $oldsel} {
		selectline $l
		set didsel 1
	    }
	}
    }
    if {$matchinglines == {}} {
	bell
    } elseif {!$didsel} {
	selectline [lindex $matchinglines 0]
    }
}

proc findnext {} {
    global matchinglines selectedline
    if {![info exists matchinglines]} {
	dofind
	return
    }
    if {![info exists selectedline]} return
    foreach l $matchinglines {
	if {$l > $selectedline} {
	    selectline $l
	    return
	}
    }
    bell
}

proc findprev {} {
    global matchinglines selectedline
    if {![info exists matchinglines]} {
	dofind
	return
    }
    if {![info exists selectedline]} return
    set prev {}
    foreach l $matchinglines {
	if {$l >= $selectedline} break
	set prev $l
    }
    if {$prev != {}} {
	selectline $prev
    } else {
	bell
    }
}

proc markmatches {canv l str tag matches font} {
    set bbox [$canv bbox $tag]
    set x0 [lindex $bbox 0]
    set y0 [lindex $bbox 1]
    set y1 [lindex $bbox 3]
    foreach match $matches {
	set start [lindex $match 0]
	set end [lindex $match 1]
	if {$start > $end} continue
	set xoff [font measure $font [string range $str 0 [expr $start-1]]]
	set xlen [font measure $font [string range $str 0 [expr $end]]]
	set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
		   -outline {} -tags matches -fill yellow]
	$canv lower $t
    }
}

proc unmarkmatches {} {
    global matchinglines
    allcanvs delete matches
    catch {unset matchinglines}
}

681 682
proc selcanvline {x y} {
    global canv canvy0 ctext linespc selectedline
683
    global lineid linehtag linentag linedtag
684 685 686 687 688 689 690 691
    set ymax [lindex [$canv cget -scrollregion] 3]
    set yfrac [lindex [$canv yview] 0]
    set y [expr {$y + $yfrac * $ymax}]
    set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
    if {$l < 0} {
	set l 0
    }
    if {[info exists selectedline] && $selectedline == $l} return
692
    unmarkmatches
693 694 695 696
    selectline $l
}

proc selectline {l} {
697 698 699
    global canv canv2 canv3 ctext commitinfo selectedline
    global lineid linehtag linentag linedtag
    global canvy canvy0 linespc nparents treepending
700
    global cflist treediffs currentid sha1entry
701
    if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
702 703 704 705 706 707 708 709 710 711 712 713
    $canv delete secsel
    set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
	       -tags secsel -fill [$canv cget -selectbackground]]
    $canv lower $t
    $canv2 delete secsel
    set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
	       -tags secsel -fill [$canv2 cget -selectbackground]]
    $canv2 lower $t
    $canv3 delete secsel
    set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
	       -tags secsel -fill [$canv3 cget -selectbackground]]
    $canv3 lower $t
714 715 716 717 718
    set y [expr {$canvy0 + $l * $linespc}]
    set ytop [expr {($y - $linespc / 2.0) / $canvy}]
    set ybot [expr {($y + $linespc / 2.0) / $canvy}]
    set wnow [$canv yview]
    if {$ytop < [lindex $wnow 0]} {
719
	allcanvs yview moveto $ytop
720 721
    } elseif {$ybot > [lindex $wnow 1]} {
	set wh [expr {[lindex $wnow 1] - [lindex $wnow 0]}]
722
	allcanvs yview moveto [expr {$ybot - $wh}]
723 724 725
    }
    set selectedline $l

726
    set id $lineid($l)
727 728 729 730 731 732 733
    $sha1entry conf -state normal
    $sha1entry delete 0 end
    $sha1entry insert 0 $id
    $sha1entry selection from 0
    $sha1entry selection to end
    $sha1entry conf -state readonly

734
    $ctext conf -state normal
735 736
    $ctext delete 0.0 end
    set info $commitinfo($id)
737 738
    $ctext insert end "Author: [lindex $info 1]  [lindex $info 2]\n"
    $ctext insert end "Committer: [lindex $info 3]  [lindex $info 4]\n"
739
    $ctext insert end "\n"
740 741 742
    $ctext insert end [lindex $info 5]
    $ctext insert end "\n"
    $ctext tag delete Comments
743 744 745
    $ctext conf -state disabled

    $cflist delete 0 end
746
    set currentid $id
747 748
    if {$nparents($id) == 1} {
	if {![info exists treediffs($id)]} {
749 750 751 752 753
	    if {![info exists treepending]} {
		gettreediffs $id
	    }
	} else {
	    addtocflist $id
754 755
	}
    }
756
}
757

758 759 760 761
proc selnextline {dir} {
    global selectedline
    if {![info exists selectedline]} return
    set l [expr $selectedline + $dir]
762
    unmarkmatches
763
    selectline $l
764 765
}

766 767 768 769 770 771
proc addtocflist {id} {
    global currentid treediffs cflist treepending
    if {$id != $currentid} {
	gettreediffs $currentid
	return
    }
772
    $cflist insert end "All files"
773 774 775
    foreach f $treediffs($currentid) {
	$cflist insert end $f
    }
776
    getblobdiffs $id
777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805
}

proc gettreediffs {id} {
    global treediffs parents treepending
    set treepending $id
    set treediffs($id) {}
    set p [lindex $parents($id) 0]
    if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
    fconfigure $gdtf -blocking 0
    fileevent $gdtf readable "gettreediffline $gdtf $id"
}

proc gettreediffline {gdtf id} {
    global treediffs treepending
    set n [gets $gdtf line]
    if {$n < 0} {
	if {![eof $gdtf]} return
	close $gdtf
	unset treepending
	addtocflist $id
	return
    }
    set type [lindex $line 1]
    set file [lindex $line 3]
    if {$type == "blob"} {
	lappend treediffs($id) $file
    }
}

806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878
proc getblobdiffs {id} {
    global parents diffopts blobdifffd env curdifftag curtagstart
    set p [lindex $parents($id) 0]
    set env(GIT_DIFF_OPTS) $diffopts
    if [catch {set bdf [open "|git-diff-tree -r -p $p $id" r]} err] {
	puts "error getting diffs: $err"
	return
    }
    fconfigure $bdf -blocking 0
    set blobdifffd($id) $bdf
    set curdifftag Comments
    set curtagstart 0.0
    fileevent $bdf readable "getblobdiffline $bdf $id"
}

proc getblobdiffline {bdf id} {
    global currentid blobdifffd ctext curdifftag curtagstart
    set n [gets $bdf line]
    if {$n < 0} {
	if {[eof $bdf]} {
	    close $bdf
	    if {$id == $currentid && $bdf == $blobdifffd($id)} {
		$ctext tag add $curdifftag $curtagstart end
	    }
	}
	return
    }
    if {$id != $currentid || $bdf != $blobdifffd($id)} {
	return
    }
    $ctext conf -state normal
    if {[regexp {^---[ \t]+([^/])+/(.*)} $line match s1 fname]} {
	# start of a new file
	$ctext insert end "\n"
	$ctext tag add $curdifftag $curtagstart end
	set curtagstart [$ctext index "end - 1c"]
	set curdifftag "f:$fname"
	$ctext tag delete $curdifftag
	set l [expr {(78 - [string length $fname]) / 2}]
	set pad [string range "----------------------------------------" 1 $l]
	$ctext insert end "$pad $fname $pad\n" filesep
    } elseif {[string range $line 0 2] == "+++"} {
	# no need to do anything with this
    } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
		   $line match f1l f1c f2l f2c rest]} {
	$ctext insert end "\t" hunksep
	$ctext insert end "    $f1l    " d0 "    $f2l    " d1
	$ctext insert end "    $rest \n" hunksep
    } else {
	set x [string range $line 0 0]
	if {$x == "-" || $x == "+"} {
	    set tag [expr {$x == "+"}]
	    set line [string range $line 1 end]
	    $ctext insert end "$line\n" d$tag
	} elseif {$x == " "} {
	    set line [string range $line 1 end]
	    $ctext insert end "$line\n"
	} else {
	    # Something else we don't recognize
	    if {$curdifftag != "Comments"} {
		$ctext insert end "\n"
		$ctext tag add $curdifftag $curtagstart end
		set curtagstart [$ctext index "end - 1c"]
		set curdifftag Comments
	    }
	    $ctext insert end "$line\n" filesep
	}
    }
    $ctext conf -state disabled
}

proc listboxsel {} {
    global ctext cflist currentid treediffs
879
    if {![info exists currentid]} return
880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896
    set sel [$cflist curselection]
    if {$sel == {} || [lsearch -exact $sel 0] >= 0} {
	# show everything
	$ctext tag conf Comments -elide 0
	foreach f $treediffs($currentid) {
	    $ctext tag conf "f:$f" -elide 0
	}
    } else {
	# just show selected files
	$ctext tag conf Comments -elide 1
	set i 1
	foreach f $treediffs($currentid) {
	    set elide [expr {[lsearch -exact $sel $i] < 0}]
	    $ctext tag conf "f:$f" -elide $elide
	    incr i
	}
    }
897 898
}

899 900 901
if {![getcommits $revtreeargs]} {
    exit 1
}
902 903 904 905 906 907 908 909 910

set linespc [font metrics $mainfont -linespace]
set charspc [font measure $mainfont "m"]

set canvy0 [expr 3 + 0.5 * $linespc]
set canvx0 [expr 3 + 0.5 * $linespc]
set namex [expr 45 * $charspc]
set datex [expr 75 * $charspc]

911
set stopped 0
912 913 914 915 916
makewindow

set start {}
foreach id $commits {
    if {$nchildren($id) == 0} {
917
	lappend start $id
918 919 920 921 922
    }
}
if {$start != {}} {
    drawgraph $start
}