gitk 43.6 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.24 $
11 12

proc getcommits {rargs} {
13
    global commits commfd phase canv mainfont
14
    global startmsecs nextupdate
15
    global ctext maincursor textcursor nlines
16

17 18 19 20
    if {$rargs == {}} {
	set rargs HEAD
    }
    set commits {}
21
    set phase getcommits
22 23 24
    set startmsecs [clock clicks -milliseconds]
    set nextupdate [expr $startmsecs + 100]
    if [catch {set commfd [open "|git-rev-list --merge-order $rargs" r]} err] {
25
	puts stderr "Error executing git-rev-list: $err"
26 27
	exit 1
    }
28
    set nlines 0
29 30 31 32 33
    fconfigure $commfd -blocking 0
    fileevent $commfd readable "getcommitline $commfd"
    $canv delete all
    $canv create text 3 3 -anchor nw -text "Reading commits..." \
	-font $mainfont -tags textitems
34 35
    . config -cursor watch
    $ctext config -cursor watch
36 37 38
}

proc getcommitline {commfd}  {
39 40
    global commits parents cdate children nchildren ncleft
    global commitlisted phase commitinfo nextupdate
41
    global stopped redisplaying nlines
42

43 44 45
    set n [gets $commfd line]
    if {$n < 0} {
	if {![eof $commfd]} return
46 47
	# this works around what is apparently a bug in Tcl...
	fconfigure $commfd -blocking 1
48
	if {![catch {close $commfd} err]} {
49
	    after idle finishcommits
50 51
	    return
	}
52
	if {[string range $err 0 4] == "usage"} {
53 54 55 56
	    set err \
{Gitk: error reading commits: bad arguments to git-rev-list.
(Note: arguments to gitk are passed to git-rev-list
to allow selection of commits to be displayed.)}
57
	} else {
58
	    set err "Error reading commits: $err"
59
	}
60
	error_popup $err
61
	exit 1
62
    }
63
    incr nlines
64
    if {![regexp {^[0-9a-f]{40}$} $line id]} {
P
Paul Mackerras 已提交
65
	error_popup "Can't parse git-rev-list output: {$line}"
66 67
	exit 1
    }
68 69 70
    lappend commits $id
    set commitlisted($id) 1
    if {![info exists commitinfo($id)]} {
71
	readcommit $id
72
    }
73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104
    foreach p $parents($id) {
	if {[info exists commitlisted($p)]} {
	    puts "oops, parent $p before child $id"
	}
    }
    drawcommit $id
    if {[clock clicks -milliseconds] >= $nextupdate} {
	doupdate
    }
    while {$redisplaying} {
	set redisplaying 0
	if {$stopped == 1} {
	    set stopped 0
	    set phase "getcommits"
	    foreach id $commits {
		drawcommit $id
		if {$stopped} break
		if {[clock clicks -milliseconds] >= $nextupdate} {
		    doupdate
		}
	    }
	}
    }
}

proc doupdate {} {
    global commfd nextupdate

    incr nextupdate 100
    fileevent $commfd readable {}
    update
    fileevent $commfd readable "getcommitline $commfd"
105 106 107
}

proc readcommit {id} {
108 109 110
    global commitinfo children nchildren parents nparents cdate ncleft
    global noreadobj

111 112 113 114 115 116 117
    set inhdr 1
    set comment {}
    set headline {}
    set auname {}
    set audate {}
    set comname {}
    set comdate {}
118 119 120
    if {![info exists nchildren($id)]} {
	set children($id) {}
	set nchildren($id) 0
121
	set ncleft($id) 0
122 123 124
    }
    set parents($id) {}
    set nparents($id) 0
125 126 127 128 129 130 131
    if {$noreadobj} {
	if [catch {set contents [exec git-cat-file commit $id]}] return
    } else {
	if [catch {set x [readobj $id]}] return
	if {[lindex $x 0] != "commit"} return
	set contents [lindex $x 1]
    }
132
    foreach line [split $contents "\n"] {
133 134 135 136 137
	if {$inhdr} {
	    if {$line == {}} {
		set inhdr 0
	    } else {
		set tag [lindex $line 0]
138 139 140 141 142
		if {$tag == "parent"} {
		    set p [lindex $line 1]
		    if {![info exists nchildren($p)]} {
			set children($p) {}
			set nchildren($p) 0
143
			set ncleft($p) 0
144 145 146 147 148 149
		    }
		    lappend parents($id) $p
		    incr nparents($id)
		    if {[lsearch -exact $children($p) $id] < 0} {
			lappend children($p) $id
			incr nchildren($p)
150 151 152
			incr ncleft($p)
		    } else {
			puts "child $id already in $p's list??"
153 154
		    }
		} elseif {$tag == "author"} {
155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176
		    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 != {}} {
177
	set cdate($id) $comdate
178 179
	set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
    }
180 181
    set commitinfo($id) [list $headline $auname $audate \
			     $comname $comdate $comment]
182 183
}

184
proc readrefs {} {
P
Paul Mackerras 已提交
185
    global tagids idtags headids idheads
186 187 188 189 190 191
    set tags [glob -nocomplain -types f .git/refs/tags/*]
    foreach f $tags {
	catch {
	    set fd [open $f r]
	    set line [read $fd]
	    if {[regexp {^[0-9a-f]{40}} $line id]} {
192 193 194
		set direct [file tail $f]
		set tagids($direct) $id
		lappend idtags($id) $direct
195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211
		set contents [split [exec git-cat-file tag $id] "\n"]
		set obj {}
		set type {}
		set tag {}
		foreach l $contents {
		    if {$l == {}} break
		    switch -- [lindex $l 0] {
			"object" {set obj [lindex $l 1]}
			"type" {set type [lindex $l 1]}
			"tag" {set tag [string range $l 4 end]}
		    }
		}
		if {$obj != {} && $type == "commit" && $tag != {}} {
		    set tagids($tag) $obj
		    lappend idtags($obj) $tag
		}
	    }
P
Paul Mackerras 已提交
212 213 214 215 216 217 218 219 220 221 222 223 224 225
	    close $fd
	}
    }
    set heads [glob -nocomplain -types f .git/refs/heads/*]
    foreach f $heads {
	catch {
	    set fd [open $f r]
	    set line [read $fd 40]
	    if {[regexp {^[0-9a-f]{40}} $line id]} {
		set head [file tail $f]
		set headids($head) $line
		lappend idheads($line) $head
	    }
	    close $fd
226 227 228 229
	}
    }
}

230 231 232 233 234 235 236 237 238 239 240 241
proc error_popup msg {
    set w .error
    toplevel $w
    wm transient $w .
    message $w.m -text $msg -justify center -aspect 400
    pack $w.m -side top -fill x -padx 20 -pady 20
    button $w.ok -text OK -command "destroy $w"
    pack $w.ok -side bottom -fill x
    bind $w <Visibility> "grab $w; focus $w"
    tkwait window $w
}

242
proc makewindow {} {
243
    global canv canv2 canv3 linespc charspc ctext cflist textfont
244 245
    global findtype findloc findstring fstring geometry
    global entries sha1entry sha1string sha1but
246
    global maincursor textcursor
247
    global linectxmenu
248 249 250 251

    menu .bar
    .bar add cascade -label "File" -menu .bar.file
    menu .bar.file
252
    .bar.file add command -label "Quit" -command doquit
253 254 255 256 257
    menu .bar.help
    .bar add cascade -label "Help" -menu .bar.help
    .bar.help add command -label "About gitk" -command about
    . configure -menu .bar

258 259 260 261 262 263 264 265 266
    if {![info exists geometry(canv1)]} {
	set geometry(canv1) [expr 45 * $charspc]
	set geometry(canv2) [expr 30 * $charspc]
	set geometry(canv3) [expr 15 * $charspc]
	set geometry(canvh) [expr 25 * $linespc + 4]
	set geometry(ctextw) 80
	set geometry(ctexth) 30
	set geometry(cflistw) 30
    }
P
Paul Mackerras 已提交
267
    panedwindow .ctop -orient vertical
268 269
    if {[info exists geometry(width)]} {
	.ctop conf -width $geometry(width) -height $geometry(height)
270 271 272
	set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
	set geometry(ctexth) [expr {($texth - 8) /
				    [font metrics $textfont -linespace]}]
273
    }
274 275 276 277 278 279 280 281 282 283
    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
284
    canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
285 286
	-bg white -bd 0 \
	-yscrollincr $linespc -yscrollcommand "$cscroll set"
287 288
    .ctop.top.clist add $canv
    set canv2 .ctop.top.clist.canv2
289
    canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
290
	-bg white -bd 0 -yscrollincr $linespc
291 292
    .ctop.top.clist add $canv2
    set canv3 .ctop.top.clist.canv3
293
    canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
294
	-bg white -bd 0 -yscrollincr $linespc
295
    .ctop.top.clist add $canv3
296
    bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
297 298

    set sha1entry .ctop.top.bar.sha1
299 300 301 302 303
    set entries $sha1entry
    set sha1but .ctop.top.bar.sha1label
    button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
	-command gotocommit -width 8
    $sha1but conf -disabledforeground [$sha1but cget -foreground]
304
    pack .ctop.top.bar.sha1label -side left
305 306
    entry $sha1entry -width 40 -font $textfont -textvariable sha1string
    trace add variable sha1string write sha1change
307 308 309 310
    pack $sha1entry -side left -pady 2
    button .ctop.top.bar.findbut -text "Find" -command dofind
    pack .ctop.top.bar.findbut -side left
    set findstring {}
311
    set fstring .ctop.top.bar.findstring
312
    lappend entries $fstring
313 314
    entry $fstring -width 30 -font $textfont -textvariable findstring
    pack $fstring -side left -expand 1 -fill x
315 316 317 318 319 320 321
    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
322

323 324
    panedwindow .ctop.cdet -orient horizontal
    .ctop add .ctop.cdet
325 326
    frame .ctop.cdet.left
    set ctext .ctop.cdet.left.ctext
327 328
    text $ctext -bg white -state disabled -font $textfont \
	-width $geometry(ctextw) -height $geometry(ctexth) \
329 330 331 332 333 334
	-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

335 336 337 338
    $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
339
    $ctext tag conf found -back yellow
340

341 342
    frame .ctop.cdet.right
    set cflist .ctop.cdet.right.cfiles
343
    listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
344 345 346 347 348
	-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
349
    bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
350

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

353 354
    bindall <1> {selcanvline %x %y}
    bindall <B1-Motion> {selcanvline %x %y}
355 356
    bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
    bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
357 358
    bindall <2> "allcanvs scan mark 0 %y"
    bindall <B2-Motion> "allcanvs scan dragto 0 %y"
359 360
    bind . <Key-Up> "selnextline -1"
    bind . <Key-Down> "selnextline 1"
361 362 363 364 365
    bind . <Key-Prior> "allcanvs yview scroll -1 pages"
    bind . <Key-Next> "allcanvs yview scroll 1 pages"
    bindkey <Key-Delete> "$ctext yview scroll -1 pages"
    bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
    bindkey <Key-space> "$ctext yview scroll 1 pages"
366 367
    bindkey p "selnextline -1"
    bindkey n "selnextline 1"
368 369 370
    bindkey b "$ctext yview scroll -1 pages"
    bindkey d "$ctext yview scroll 18 units"
    bindkey u "$ctext yview scroll -18 units"
371 372
    bindkey / findnext
    bindkey ? findprev
373
    bindkey f nextfile
374
    bind . <Control-q> doquit
375 376 377
    bind . <Control-f> dofind
    bind . <Control-g> findnext
    bind . <Control-r> findprev
378 379 380 381
    bind . <Control-equal> {incrfont 1}
    bind . <Control-KP_Add> {incrfont 1}
    bind . <Control-minus> {incrfont -1}
    bind . <Control-KP_Subtract> {incrfont -1}
382
    bind $cflist <<ListboxSelect>> listboxsel
383
    bind . <Destroy> {savestuff %W}
384
    bind . <Button-1> "click %W"
385
    bind $fstring <Key-Return> dofind
386
    bind $sha1entry <Key-Return> gotocommit
387 388 389

    set maincursor [. cget -cursor]
    set textcursor [$ctext cget -cursor]
390 391 392 393

    set linectxmenu .linectxmenu
    menu $linectxmenu -tearoff 0
    $linectxmenu add command -label "Select" -command lineselect
394 395 396 397 398 399
}

# when we make a key binding for the toplevel, make sure
# it doesn't get triggered when that key is pressed in the
# find string entry widget.
proc bindkey {ev script} {
400
    global entries
401 402 403 404 405
    bind . $ev $script
    set escript [bind Entry $ev]
    if {$escript == {}} {
	set escript [bind Entry <Key>]
    }
406 407 408
    foreach e $entries {
	bind $e $ev "$escript; break"
    }
409 410 411
}

# set the focus back to the toplevel for any click outside
412
# the entry widgets
413
proc click {w} {
414 415 416
    global entries
    foreach e $entries {
	if {$w == $e} return
417
    }
418
    focus .
419 420 421 422 423 424
}

proc savestuff {w} {
    global canv canv2 canv3 ctext cflist mainfont textfont
    global stuffsaved
    if {$stuffsaved} return
425
    if {![winfo viewable .]} return
426 427 428 429 430 431
    catch {
	set f [open "~/.gitk-new" w]
	puts $f "set mainfont {$mainfont}"
	puts $f "set textfont {$textfont}"
	puts $f "set geometry(width) [winfo width .ctop]"
	puts $f "set geometry(height) [winfo height .ctop]"
432 433 434 435
	puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
	puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
	puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
	puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
436 437 438 439 440 441 442 443 444 445
	set wid [expr {([winfo width $ctext] - 8) \
			   / [font measure $textfont "0"]}]
	puts $f "set geometry(ctextw) $wid"
	set wid [expr {([winfo width $cflist] - 11) \
			   / [font measure [$cflist cget -font] "0"]}]
	puts $f "set geometry(cflistw) $wid"
	close $f
	file rename -force "~/.gitk-new" "~/.gitk"
    }
    set stuffsaved 1
446 447
}

448 449 450 451 452 453 454 455 456 457 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
proc resizeclistpanes {win w} {
    global oldwidth
    if [info exists oldwidth($win)] {
	set s0 [$win sash coord 0]
	set s1 [$win sash coord 1]
	if {$w < 60} {
	    set sash0 [expr {int($w/2 - 2)}]
	    set sash1 [expr {int($w*5/6 - 2)}]
	} else {
	    set factor [expr {1.0 * $w / $oldwidth($win)}]
	    set sash0 [expr {int($factor * [lindex $s0 0])}]
	    set sash1 [expr {int($factor * [lindex $s1 0])}]
	    if {$sash0 < 30} {
		set sash0 30
	    }
	    if {$sash1 < $sash0 + 20} {
		set sash1 [expr $sash0 + 20]
	    }
	    if {$sash1 > $w - 10} {
		set sash1 [expr $w - 10]
		if {$sash0 > $sash1 - 20} {
		    set sash0 [expr $sash1 - 20]
		}
	    }
	}
	$win sash place 0 $sash0 [lindex $s0 1]
	$win sash place 1 $sash1 [lindex $s1 1]
    }
    set oldwidth($win) $w
}

proc resizecdetpanes {win w} {
    global oldwidth
    if [info exists oldwidth($win)] {
	set s0 [$win sash coord 0]
	if {$w < 60} {
	    set sash0 [expr {int($w*3/4 - 2)}]
	} else {
	    set factor [expr {1.0 * $w / $oldwidth($win)}]
	    set sash0 [expr {int($factor * [lindex $s0 0])}]
	    if {$sash0 < 45} {
		set sash0 45
	    }
	    if {$sash0 > $w - 15} {
		set sash0 [expr $w - 15]
	    }
	}
	$win sash place 0 $sash0 [lindex $s0 1]
    }
    set oldwidth($win) $w
}

500 501 502 503 504 505 506 507 508 509 510 511 512 513
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
}

514 515 516 517 518 519 520 521 522
proc about {} {
    set w .about
    if {[winfo exists $w]} {
	raise $w
	return
    }
    toplevel $w
    wm title $w "About gitk"
    message $w.m -text {
523
Gitk version 1.1
524 525 526 527 528

Copyright  2005 Paul Mackerras

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

529
(CVS $Revision: 1.24 $)} \
530 531 532 533 534 535
	    -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
}

536 537 538 539 540
proc assigncolor {id} {
    global commitinfo colormap commcolors colors nextcolor
    global parents nparents children nchildren
    if [info exists colormap($id)] return
    set ncolors [llength $colors]
541 542 543 544 545 546
    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
547
	}
548 549 550 551 552 553
    }
    set badcolors {}
    foreach child $children($id) {
	if {[info exists colormap($child)]
	    && [lsearch -exact $badcolors $colormap($child)] < 0} {
	    lappend badcolors $colormap($child)
554
	}
555 556 557 558 559
	if {[info exists parents($child)]} {
	    foreach p $parents($child) {
		if {[info exists colormap($p)]
		    && [lsearch -exact $badcolors $colormap($p)] < 0} {
		    lappend badcolors $colormap($p)
560 561 562
		}
	    }
	}
563 564 565 566 567 568 569 570
    }
    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
571
	}
572
	if {[lsearch -exact $badcolors $c]} break
573
    }
574
    set colormap($id) $c
575 576
}

577 578
proc initgraph {} {
    global canvy canvy0 lineno numcommits lthickness nextcolor linespc
579
    global glines
580
    global nchildren ncleft
581

582
    allcanvs delete all
583 584 585 586 587
    set nextcolor 0
    set canvy $canvy0
    set lineno -1
    set numcommits 0
    set lthickness [expr {int($linespc / 9) + 1}]
588
    catch {unset glines}
589
    foreach id [array names nchildren] {
590
	set ncleft($id) $nchildren($id)
591 592 593 594 595 596 597 598 599 600 601
    }
}

proc drawcommitline {level} {
    global parents children nparents nchildren ncleft todo
    global canv canv2 canv3 mainfont namefont canvx0 canvy linespc
    global datemode cdate
    global lineid linehtag linentag linedtag commitinfo
    global colormap numcommits currentparents
    global oldlevel oldnlines oldtodo
    global idtags idline idheads
602
    global lineno lthickness glines
603 604 605 606 607 608 609 610 611 612 613 614
    global commitlisted

    incr numcommits
    incr lineno
    set id [lindex $todo $level]
    set lineid($lineno) $id
    set idline($id) $lineno
    set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
    if {![info exists commitinfo($id)]} {
	readcommit $id
	if {![info exists commitinfo($id)]} {
	    set commitinfo($id) {"No commit information available"}
615 616
	    set nparents($id) 0
	}
617
    }
618 619 620
    set currentparents {}
    if {[info exists commitlisted($id)] && [info exists parents($id)]} {
	set currentparents $parents($id)
621
    }
622 623 624 625 626
    set x [expr $canvx0 + $level * $linespc]
    set y1 $canvy
    set canvy [expr $canvy + $linespc]
    allcanvs conf -scrollregion \
	[list 0 0 0 [expr $y1 + 0.5 * $linespc + 2]]
627 628 629
    if {[info exists glines($id)]} {
	lappend glines($id) $x $y1
	set t [$canv create line $glines($id) \
630 631
		   -width $lthickness -fill $colormap($id)]
	$canv lower $t
632 633 634 635
	$canv bind $t <Button-3> "linemenu %X %Y $id"
	$canv bind $t <Enter> "lineenter %x %y $id"
	$canv bind $t <Motion> "linemotion %x %y $id"
	$canv bind $t <Leave> "lineleave $id"
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
    set orad [expr {$linespc / 3}]
    set t [$canv create oval [expr $x - $orad] [expr $y1 - $orad] \
	       [expr $x + $orad - 1] [expr $y1 + $orad - 1] \
	       -fill $ofill -outline black -width 1]
    $canv raise $t
    set xt [expr $canvx0 + [llength $todo] * $linespc]
    if {$nparents($id) > 2} {
	set xt [expr {$xt + ($nparents($id) - 2) * $linespc}]
    }
    set marks {}
    set ntags 0
    if {[info exists idtags($id)]} {
	set marks $idtags($id)
	set ntags [llength $marks]
    }
    if {[info exists idheads($id)]} {
	set marks [concat $marks $idheads($id)]
    }
    if {$marks != {}} {
	set delta [expr {int(0.5 * ($linespc - $lthickness))}]
	set yt [expr $y1 - 0.5 * $linespc]
	set yb [expr $yt + $linespc - 1]
	set xvals {}
	set wvals {}
	foreach tag $marks {
	    set wid [font measure $mainfont $tag]
	    lappend xvals $xt
	    lappend wvals $wid
	    set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
P
Paul Mackerras 已提交
666
	}
667 668 669
	set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
		   -width $lthickness -fill black]
	$canv lower $t
670 671 672 673
	$canv bind $t <Button-3> "linemenu %X %Y $id"
	$canv bind $t <Enter> "lineenter %x %y $id"
	$canv bind $t <Motion> "linemotion %x %y $id"
	$canv bind $t <Leave> "lineleave $id"
674 675 676 677 678 679 680 681 682 683 684 685 686
	foreach tag $marks x $xvals wid $wvals {
	    set xl [expr $x + $delta]
	    set xr [expr $x + $delta + $wid + $lthickness]
	    if {[incr ntags -1] >= 0} {
		# draw a tag
		$canv create polygon $x [expr $yt + $delta] $xl $yt\
		    $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \
		    -width 1 -outline black -fill yellow
	    } else {
		# draw a head
		set xl [expr $xl - $delta/2]
		$canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
		    -width 1 -outline black -fill green
687
	    }
688 689
	    $canv create text $xl $y1 -anchor w -text $tag \
		-font $mainfont
690
	}
691 692 693 694 695 696 697 698 699 700 701 702 703 704
    }
    set headline [lindex $commitinfo($id) 0]
    set name [lindex $commitinfo($id) 1]
    set date [lindex $commitinfo($id) 2]
    set linehtag($lineno) [$canv create text $xt $y1 -anchor w \
			       -text $headline -font $mainfont ]
    set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \
			       -text $name -font $namefont]
    set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \
			       -text $date -font $mainfont]
}

proc updatetodo {level noshortcut} {
    global datemode currentparents ncleft todo
705 706
    global glines oldlevel oldtodo oldnlines
    global canvx0 canvy linespc glines
707 708 709 710 711
    global commitinfo

    foreach p $currentparents {
	if {![info exists commitinfo($p)]} {
	    readcommit $p
712
	}
713
    }
714 715
    set x [expr $canvx0 + $level * $linespc]
    set y [expr $canvy - $linespc]
716 717 718 719
    if {!$noshortcut && [llength $currentparents] == 1} {
	set p [lindex $currentparents 0]
	if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} {
	    assigncolor $p
720
	    set glines($p) [list $x $y]
721 722
	    set todo [lreplace $todo $level $level $p]
	    return 0
P
Paul Mackerras 已提交
723
	}
724 725 726 727 728 729 730 731 732 733 734 735 736 737
    }

    set oldlevel $level
    set oldtodo $todo
    set oldnlines [llength $todo]
    set todo [lreplace $todo $level $level]
    set i $level
    foreach p $currentparents {
	incr ncleft($p) -1
	set k [lsearch -exact $todo $p]
	if {$k < 0} {
	    assigncolor $p
	    set todo [linsert $todo $i $p]
	    incr i
P
Paul Mackerras 已提交
738
	}
739 740 741 742 743
    }
    return 1
}

proc drawslants {} {
744
    global canv glines canvx0 canvy linespc
745 746 747 748 749 750 751 752 753 754 755 756 757
    global oldlevel oldtodo todo currentparents
    global lthickness linespc canvy colormap

    set y1 [expr $canvy - $linespc]
    set y2 $canvy
    set i -1
    foreach id $oldtodo {
	incr i
	if {$id == {}} continue
	set xi [expr {$canvx0 + $i * $linespc}]
	if {$i == $oldlevel} {
	    foreach p $currentparents {
		set j [lsearch -exact $todo $p]
758 759
		if {$i == $j && ![info exists glines($p)]} {
		    set glines($p) [list $xi $y1]
P
Paul Mackerras 已提交
760
		} else {
761 762 763 764 765 766 767 768
		    set xj [expr {$canvx0 + $j * $linespc}]
		    set coords [list $xi $y1]
		    if {$j < $i - 1} {
			lappend coords [expr $xj + $linespc] $y1
		    } elseif {$j > $i + 1} {
			lappend coords [expr $xj - $linespc] $y1
		    }
		    lappend coords $xj $y2
769 770 771 772 773 774 775 776 777 778
		    if {![info exists glines($p)]} {
			set glines($p) $coords
		    } else {
			set t [$canv create line $coords -width $lthickness \
				   -fill $colormap($p)]
			$canv lower $t
			$canv bind $t <Button-3> "linemenu %X %Y $p"
			$canv bind $t <Enter> "lineenter %x %y $p"
			$canv bind $t <Motion> "linemotion %x %y $p"
			$canv bind $t <Leave> "lineleave $p"
779
		    }
P
Paul Mackerras 已提交
780
		}
781
	    }
782 783 784
	} elseif {[lindex $todo $i] != $id} {
	    set j [lsearch -exact $todo $id]
	    set xj [expr {$canvx0 + $j * $linespc}]
785
	    lappend glines($id) $xi $y1 $xj $y2
786
	}
787 788
    }
}
789

790 791 792 793 794 795 796
proc decidenext {} {
    global parents children nchildren ncleft todo
    global canv canv2 canv3 mainfont namefont canvx0 canvy linespc
    global datemode cdate
    global lineid linehtag linentag linedtag commitinfo
    global currentparents oldlevel oldnlines oldtodo
    global lineno lthickness
797

798 799 800 801 802
    # remove the null entry if present
    set nullentry [lsearch -exact $todo {}]
    if {$nullentry >= 0} {
	set todo [lreplace $todo $nullentry $nullentry]
    }
803

804 805 806 807 808 809 810 811 812
    # 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 {$ncleft($p) == 0} {
	    if {$datemode} {
		if {$latest == {} || $cdate($p) > $latest} {
813
		    set level $k
814
		    set latest $cdate($p)
815
		}
816 817 818
	    } else {
		set level $k
		break
819 820
	    }
	}
821 822 823 824 825 826
    }
    if {$level < 0} {
	if {$todo != {}} {
	    puts "ERROR: none of the pending commits can be done yet:"
	    foreach p $todo {
		puts "  $p"
827 828
	    }
	}
829 830
	return -1
    }
831

832 833 834 835 836 837 838
    # If we are reducing, put in a null entry
    if {$todol < $oldnlines} {
	if {$nullentry >= 0} {
	    set i $nullentry
	    while {$i < $todol
		   && [lindex $oldtodo $i] == [lindex $todo $i]} {
		incr i
839 840
	    }
	} else {
841 842 843 844
	    set i $oldlevel
	    if {$level >= $i} {
		incr i
	    }
845
	}
846 847 848 849 850 851 852 853 854
	if {$i < $todol} {
	    set todo [linsert $todo $i {}]
	    if {$level >= $i} {
		incr level
	    }
	}
    }
    return $level
}
855

856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882
proc drawcommit {id} {
    global phase todo nchildren datemode nextupdate
    global startcommits

    if {$phase != "incrdraw"} {
	set phase incrdraw
	set todo $id
	set startcommits $id
	initgraph
	assigncolor $id
	drawcommitline 0
	updatetodo 0 $datemode
    } else {
	if {$nchildren($id) == 0} {
	    lappend todo $id
	    lappend startcommits $id
	    assigncolor $id
	}
	set level [decidenext]
	if {$id != [lindex $todo $level]} {
	    return
	}
	while 1 {
	    drawslants
	    drawcommitline $level
	    if {[updatetodo $level $datemode]} {
		set level [decidenext]
883
	    }
884 885 886
	    set id [lindex $todo $level]
	    if {![info exists commitlisted($id)]} {
		break
887
	    }
888 889 890
	    if {[clock clicks -milliseconds] >= $nextupdate} {
		doupdate
		if {$stopped} break
891
	    }
892 893 894 895 896 897 898
	}
    }
}

proc finishcommits {} {
    global phase
    global startcommits
899
    global ctext maincursor textcursor
900 901 902 903 904 905 906 907 908 909 910

    if {$phase != "incrdraw"} {
	$canv delete all
	$canv create text 3 3 -anchor nw -text "No commits selected" \
	    -font $mainfont -tags textitems
	set phase {}
	return
    }
    drawslants
    set level [decidenext]
    drawrest $level [llength $startcommits]
911 912
    . config -cursor $maincursor
    $ctext config -cursor $textcursor
913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949
}

proc drawgraph {} {
    global nextupdate startmsecs startcommits todo

    if {$startcommits == {}} return
    set startmsecs [clock clicks -milliseconds]
    set nextupdate [expr $startmsecs + 100]
    initgraph
    set todo [lindex $startcommits 0]
    drawrest 0 1
}

proc drawrest {level startix} {
    global phase stopped redisplaying selectedline
    global datemode currentparents todo
    global numcommits
    global nextupdate startmsecs startcommits idline

    set phase drawgraph
    set startid [lindex $startcommits $startix]
    set startline -1
    if {$startid != {}} {
	set startline $idline($startid)
    }
    while 1 {
	if {$stopped} break
	drawcommitline $level
	set hard [updatetodo $level $datemode]
	if {$numcommits == $startline} {
	    lappend todo $startid
	    set hard 1
	    incr startix
	    set startid [lindex $startcommits $startix]
	    set startline -1
	    if {$startid != {}} {
		set startline $idline($startid)
950 951
	    }
	}
952 953 954 955 956 957 958 959 960
	if {$hard} {
	    set level [decidenext]
	    if {$level < 0} break
	    drawslants
	}
	if {[clock clicks -milliseconds] >= $nextupdate} {
	    update
	    incr nextupdate 100
	}
961
    }
962
    set phase {}
963
    set drawmsecs [expr [clock clicks -milliseconds] - $startmsecs]
964
    #puts "overall $drawmsecs ms for $numcommits commits"
965 966 967 968 969 970 971 972 973 974 975
    if {$redisplaying} {
	if {$stopped == 0 && [info exists selectedline]} {
	    selectline $selectedline
	}
	if {$stopped == 1} {
	    set stopped 0
	    after idle drawgraph
	} else {
	    set redisplaying 0
	}
    }
976 977
}

978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997
proc findmatches {f} {
    global findtype foundstring foundstrlen
    if {$findtype == "Regexp"} {
	set matches [regexp -indices -all -inline $foundstring $f]
    } else {
	if {$findtype == "IgnCase"} {
	    set str [string tolower $f]
	} else {
	    set str $f
	}
	set matches {}
	set i 0
	while {[set j [string first $foundstring $str $i]] >= 0} {
	    lappend matches [list $j [expr $j+$foundstrlen-1]]
	    set i [expr $j + $foundstrlen]
	}
    }
    return $matches
}

998 999 1000 1001
proc dofind {} {
    global findtype findloc findstring markedmatches commitinfo
    global numcommits lineid linehtag linentag linedtag
    global mainfont namefont canv canv2 canv3 selectedline
1002
    global matchinglines foundstring foundstrlen
1003
    unmarkmatches
1004
    focus .
1005 1006 1007
    set matchinglines {}
    set fldtypes {Headline Author Date Committer CDate Comment}
    if {$findtype == "IgnCase"} {
1008
	set foundstring [string tolower $findstring]
1009
    } else {
1010
	set foundstring $findstring
1011
    }
1012 1013
    set foundstrlen [string length $findstring]
    if {$foundstrlen == 0} return
1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027
    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
	    }
1028
	    set matches [findmatches $f]
1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041
	    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} {
1042
		findselectline $l
1043 1044 1045 1046 1047 1048 1049
		set didsel 1
	    }
	}
    }
    if {$matchinglines == {}} {
	bell
    } elseif {!$didsel} {
1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065
	findselectline [lindex $matchinglines 0]
    }
}

proc findselectline {l} {
    global findloc commentend ctext
    selectline $l
    if {$findloc == "All fields" || $findloc == "Comments"} {
	# highlight the matches in the comments
	set f [$ctext get 1.0 $commentend]
	set matches [findmatches $f]
	foreach match $matches {
	    set start [lindex $match 0]
	    set end [expr [lindex $match 1] + 1]
	    $ctext tag add found "1.0 + $start c" "1.0 + $end c"
	}
1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077
    }
}

proc findnext {} {
    global matchinglines selectedline
    if {![info exists matchinglines]} {
	dofind
	return
    }
    if {![info exists selectedline]} return
    foreach l $matchinglines {
	if {$l > $selectedline} {
1078
	    findselectline $l
1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097
	    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 != {}} {
1098
	findselectline $prev
1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126
    } 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}
}

1127 1128
proc selcanvline {x y} {
    global canv canvy0 ctext linespc selectedline
1129
    global lineid linehtag linentag linedtag
1130
    set ymax [lindex [$canv cget -scrollregion] 3]
1131
    if {$ymax == {}} return
1132 1133 1134 1135 1136 1137 1138
    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
1139
    unmarkmatches
1140 1141 1142 1143
    selectline $l
}

proc selectline {l} {
1144 1145
    global canv canv2 canv3 ctext commitinfo selectedline
    global lineid linehtag linentag linedtag
1146
    global canvy0 linespc nparents treepending
1147
    global cflist treediffs currentid sha1entry
1148
    global commentend seenfile idtags
1149
    $canv delete hover
1150
    if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162
    $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
1163
    set y [expr {$canvy0 + $l * $linespc}]
1164
    set ymax [lindex [$canv cget -scrollregion] 3]
1165 1166
    set ytop [expr {$y - $linespc - 1}]
    set ybot [expr {$y + $linespc + 1}]
1167
    set wnow [$canv yview]
1168 1169 1170 1171
    set wtop [expr [lindex $wnow 0] * $ymax]
    set wbot [expr [lindex $wnow 1] * $ymax]
    set wh [expr {$wbot - $wtop}]
    set newtop $wtop
1172
    if {$ytop < $wtop} {
1173 1174 1175 1176 1177 1178 1179
	if {$ybot < $wtop} {
	    set newtop [expr {$y - $wh / 2.0}]
	} else {
	    set newtop $ytop
	    if {$newtop > $wtop - $linespc} {
		set newtop [expr {$wtop - $linespc}]
	    }
1180
	}
1181 1182 1183 1184 1185 1186 1187 1188
    } elseif {$ybot > $wbot} {
	if {$ytop > $wbot} {
	    set newtop [expr {$y - $wh / 2.0}]
	} else {
	    set newtop [expr {$ybot - $wh}]
	    if {$newtop < $wtop + $linespc} {
		set newtop [expr {$wtop + $linespc}]
	    }
1189
	}
1190 1191 1192 1193 1194 1195
    }
    if {$newtop != $wtop} {
	if {$newtop < 0} {
	    set newtop 0
	}
	allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
1196 1197 1198
    }
    set selectedline $l

1199
    set id $lineid($l)
1200
    set currentid $id
1201 1202 1203 1204 1205
    $sha1entry delete 0 end
    $sha1entry insert 0 $id
    $sha1entry selection from 0
    $sha1entry selection to end

1206
    $ctext conf -state normal
1207 1208
    $ctext delete 0.0 end
    set info $commitinfo($id)
1209 1210
    $ctext insert end "Author: [lindex $info 1]  [lindex $info 2]\n"
    $ctext insert end "Committer: [lindex $info 3]  [lindex $info 4]\n"
1211 1212 1213 1214 1215 1216 1217
    if {[info exists idtags($id)]} {
	$ctext insert end "Tags:"
	foreach tag $idtags($id) {
	    $ctext insert end " $tag"
	}
	$ctext insert end "\n"
    }
1218
    $ctext insert end "\n"
1219 1220 1221
    $ctext insert end [lindex $info 5]
    $ctext insert end "\n"
    $ctext tag delete Comments
1222
    $ctext tag remove found 1.0 end
1223
    $ctext conf -state disabled
1224
    set commentend [$ctext index "end - 1c"]
1225 1226 1227 1228

    $cflist delete 0 end
    if {$nparents($id) == 1} {
	if {![info exists treediffs($id)]} {
1229 1230 1231 1232 1233
	    if {![info exists treepending]} {
		gettreediffs $id
	    }
	} else {
	    addtocflist $id
1234 1235
	}
    }
1236
    catch {unset seenfile}
1237
}
1238

1239 1240 1241 1242
proc selnextline {dir} {
    global selectedline
    if {![info exists selectedline]} return
    set l [expr $selectedline + $dir]
1243
    unmarkmatches
1244
    selectline $l
1245 1246
}

1247 1248 1249 1250 1251 1252
proc addtocflist {id} {
    global currentid treediffs cflist treepending
    if {$id != $currentid} {
	gettreediffs $currentid
	return
    }
1253
    $cflist insert end "All files"
1254 1255 1256
    foreach f $treediffs($currentid) {
	$cflist insert end $f
    }
1257
    getblobdiffs $id
1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279
}

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
    }
1280 1281
    set file [lindex $line 5]
    lappend treediffs($id) $file
1282 1283
}

1284 1285
proc getblobdiffs {id} {
    global parents diffopts blobdifffd env curdifftag curtagstart
1286
    global diffindex difffilestart
1287 1288 1289 1290 1291 1292 1293 1294 1295 1296
    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
1297 1298
    set diffindex 0
    catch {unset difffilestart}
1299 1300 1301 1302
    fileevent $bdf readable "getblobdiffline $bdf $id"
}

proc getblobdiffline {bdf id} {
1303
    global currentid blobdifffd ctext curdifftag curtagstart seenfile
1304
    global diffnexthead diffnextnote diffindex difffilestart
1305 1306 1307 1308 1309 1310
    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
1311
		set seenfile($curdifftag) 1
1312 1313 1314 1315 1316 1317 1318 1319
	    }
	}
	return
    }
    if {$id != $currentid || $bdf != $blobdifffd($id)} {
	return
    }
    $ctext conf -state normal
1320
    if {[regexp {^---[ \t]+([^/])*/(.*)} $line match s1 fname]} {
1321 1322 1323
	# start of a new file
	$ctext insert end "\n"
	$ctext tag add $curdifftag $curtagstart end
1324
	set seenfile($curdifftag) 1
1325
	set curtagstart [$ctext index "end - 1c"]
1326
	set header $fname
1327 1328
	if {[info exists diffnexthead]} {
	    set fname $diffnexthead
1329
	    set header "$diffnexthead ($diffnextnote)"
1330 1331
	    unset diffnexthead
	}
1332 1333
	set difffilestart($diffindex) [$ctext index "end - 1c"]
	incr diffindex
1334 1335
	set curdifftag "f:$fname"
	$ctext tag delete $curdifftag
1336
	set l [expr {(78 - [string length $header]) / 2}]
1337
	set pad [string range "----------------------------------------" 1 $l]
1338
	$ctext insert end "$pad $header $pad\n" filesep
1339 1340
    } elseif {[string range $line 0 2] == "+++"} {
	# no need to do anything with this
1341
    } elseif {[regexp {^Created: (.*) \((mode: *[0-7]*)\)} $line match fn m]} {
1342
	set diffnexthead $fn
1343
	set diffnextnote "created, mode $m"
1344 1345
    } elseif {[string range $line 0 8] == "Deleted: "} {
	set diffnexthead [string range $line 9 end]
1346
	set diffnextnote "deleted"
1347 1348 1349 1350 1351 1352 1353 1354
    } elseif {[regexp {^diff --git a/(.*) b/} $line match fn]} {
	# save the filename in case the next thing is "new file mode ..."
	set diffnexthead $fn
	set diffnextnote "modified"
    } elseif {[regexp {^new file mode ([0-7]+)} $line match m]} {
	set diffnextnote "new file, mode $m"
    } elseif {[string range $line 0 11] == "deleted file"} {
	set diffnextnote "deleted"
1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368
    } 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"
1369 1370 1371
	} elseif {$x == "\\"} {
	    # e.g. "\ No newline at end of file"
	    $ctext insert end "$line\n" filesep
1372 1373 1374 1375 1376
	} else {
	    # Something else we don't recognize
	    if {$curdifftag != "Comments"} {
		$ctext insert end "\n"
		$ctext tag add $curdifftag $curtagstart end
1377
		set seenfile($curdifftag) 1
1378 1379 1380 1381 1382 1383 1384 1385 1386
		set curtagstart [$ctext index "end - 1c"]
		set curdifftag Comments
	    }
	    $ctext insert end "$line\n" filesep
	}
    }
    $ctext conf -state disabled
}

1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397
proc nextfile {} {
    global difffilestart ctext
    set here [$ctext index @0,0]
    for {set i 0} {[info exists difffilestart($i)]} {incr i} {
	if {[$ctext compare $difffilestart($i) > $here]} {
	    $ctext yview $difffilestart($i)
	    break
	}
    }
}

1398
proc listboxsel {} {
1399
    global ctext cflist currentid treediffs seenfile
1400
    if {![info exists currentid]} return
1401 1402 1403 1404 1405
    set sel [$cflist curselection]
    if {$sel == {} || [lsearch -exact $sel 0] >= 0} {
	# show everything
	$ctext tag conf Comments -elide 0
	foreach f $treediffs($currentid) {
1406 1407 1408
	    if [info exists seenfile(f:$f)] {
		$ctext tag conf "f:$f" -elide 0
	    }
1409 1410 1411 1412 1413 1414 1415
	}
    } 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}]
1416 1417 1418
	    if [info exists seenfile(f:$f)] {
		$ctext tag conf "f:$f" -elide $elide
	    }
1419 1420 1421
	    incr i
	}
    }
1422 1423
}

1424 1425 1426 1427 1428 1429
proc setcoords {} {
    global linespc charspc canvx0 canvy0 mainfont
    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]
1430
}
1431

1432 1433 1434 1435 1436
proc redisplay {} {
    global selectedline stopped redisplaying phase
    if {$stopped > 1} return
    if {$phase == "getcommits"} return
    set redisplaying 1
1437
    if {$phase == "drawgraph" || $phase == "incrdraw"} {
1438 1439 1440 1441 1442 1443 1444 1445
	set stopped 1
    } else {
	drawgraph
    }
}

proc incrfont {inc} {
    global mainfont namefont textfont selectedline ctext canv phase
1446
    global stopped entries
1447 1448 1449 1450 1451 1452 1453
    unmarkmatches
    set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
    set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
    set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
    setcoords
    $ctext conf -font $textfont
    $ctext tag conf filesep -font [concat $textfont bold]
1454 1455 1456
    foreach e $entries {
	$e conf -font $mainfont
    }
1457 1458 1459 1460 1461
    if {$phase == "getcommits"} {
	$canv itemconf textitems -font $mainfont
    }
    redisplay
}
1462

1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499
proc sha1change {n1 n2 op} {
    global sha1string currentid sha1but
    if {$sha1string == {}
	|| ([info exists currentid] && $sha1string == $currentid)} {
	set state disabled
    } else {
	set state normal
    }
    if {[$sha1but cget -state] == $state} return
    if {$state == "normal"} {
	$sha1but conf -state normal -relief raised -text "Goto: "
    } else {
	$sha1but conf -state disabled -relief flat -text "SHA1 ID: "
    }
}

proc gotocommit {} {
    global sha1string currentid idline tagids
    if {$sha1string == {}
	|| ([info exists currentid] && $sha1string == $currentid)} return
    if {[info exists tagids($sha1string)]} {
	set id $tagids($sha1string)
    } else {
	set id [string tolower $sha1string]
    }
    if {[info exists idline($id)]} {
	selectline $idline($id)
	return
    }
    if {[regexp {^[0-9a-fA-F]{40}$} $sha1string]} {
	set type "SHA1 id"
    } else {
	set type "Tag"
    }
    error_popup "$type $sha1string is not known"
}

1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575
proc linemenu {x y id} {
    global linectxmenu linemenuid
    set linemenuid $id
    $linectxmenu post $x $y
}

proc lineselect {} {
    global linemenuid idline
    if {[info exists linemenuid] && [info exists idline($linemenuid)]} {
	selectline $idline($linemenuid)
    }
}

proc lineenter {x y id} {
    global hoverx hovery hoverid hovertimer
    global commitinfo canv

    if {![info exists commitinfo($id)]} return
    set hoverx $x
    set hovery $y
    set hoverid $id
    if {[info exists hovertimer]} {
	after cancel $hovertimer
    }
    set hovertimer [after 500 linehover]
    $canv delete hover
}

proc linemotion {x y id} {
    global hoverx hovery hoverid hovertimer

    if {[info exists hoverid] && $id == $hoverid} {
	set hoverx $x
	set hovery $y
	if {[info exists hovertimer]} {
	    after cancel $hovertimer
	}
	set hovertimer [after 500 linehover]
    }
}

proc lineleave {id} {
    global hoverid hovertimer canv

    if {[info exists hoverid] && $id == $hoverid} {
	$canv delete hover
	if {[info exists hovertimer]} {
	    after cancel $hovertimer
	    unset hovertimer
	}
	unset hoverid
    }
}

proc linehover {} {
    global hoverx hovery hoverid hovertimer
    global canv linespc lthickness
    global commitinfo mainfont

    set text [lindex $commitinfo($hoverid) 0]
    set ymax [lindex [$canv cget -scrollregion] 3]
    if {$ymax == {}} return
    set yfrac [lindex [$canv yview] 0]
    set x [expr {$hoverx + 2 * $linespc}]
    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
    set x0 [expr {$x - 2 * $lthickness}]
    set y0 [expr {$y - 2 * $lthickness}]
    set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
    set y1 [expr {$y + $linespc + 2 * $lthickness}]
    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
	       -fill \#ffff80 -outline black -width 1 -tags hover]
    $canv raise $t
    set t [$canv create text $x $y -anchor nw -text $text -tags hover]
    $canv raise $t
}

1576 1577 1578 1579 1580
proc doquit {} {
    global stopped
    set stopped 100
    destroy .
}
1581

1582 1583 1584 1585
# defaults...
set datemode 0
set boldnames 0
set diffopts "-U 5 -p"
1586

1587 1588 1589 1590 1591 1592 1593
set mainfont {Helvetica 9}
set textfont {Courier 9}

set colors {green red blue magenta darkgrey brown orange}

catch {source ~/.gitk}

1594 1595 1596 1597 1598
set namefont $mainfont
if {$boldnames} {
    lappend namefont bold
}

1599 1600 1601 1602 1603 1604 1605 1606 1607 1608
set revtreeargs {}
foreach arg $argv {
    switch -regexp -- $arg {
	"^$" { }
	"^-b" { set boldnames 1 }
	"^-d" { set datemode 1 }
	default {
	    lappend revtreeargs $arg
	}
    }
1609
}
1610

1611
set noreadobj [catch {load libreadobj.so.0.0}]
1612 1613
set stopped 0
set redisplaying 0
1614
set stuffsaved 0
1615 1616
setcoords
makewindow
1617
readrefs
1618
getcommits $revtreeargs