gitk

   1 #!/bin/sh
   2 # Tcl ignores the next line -*- tcl -*- \
   3 exec wish "$0" -- "$@"
   4
   5 # Copyright © 2005-2008 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
  10 proc gitdir {} {
  11     global env
  12     if {[info exists env(GIT_DIR)]} {
  13         return $env(GIT_DIR)
  14     } else {
  15         return [exec git rev-parse --git-dir]
  16     }
  17 }
  18
  19 # A simple scheduler for compute-intensive stuff.
  20 # The aim is to make sure that event handlers for GUI actions can
  21 # run at least every 50-100 ms.  Unfortunately fileevent handlers are
  22 # run before X event handlers, so reading from a fast source can
  23 # make the GUI completely unresponsive.
  24 proc run args {
  25     global isonrunq runq currunq
  26
  27     set script $args
  28     if {[info exists isonrunq($script)]} return
  29     if {$runq eq {} && ![info exists currunq]} {
  30         after idle dorunq
  31     }
  32     lappend runq [list {} $script]
  33     set isonrunq($script) 1
  34 }
  35
  36 proc filerun {fd script} {
  37     fileevent $fd readable [list filereadable $fd $script]
  38 }
  39
  40 proc filereadable {fd script} {
  41     global runq currunq
  42
  43     fileevent $fd readable {}
  44     if {$runq eq {} && ![info exists currunq]} {
  45         after idle dorunq
  46     }
  47     lappend runq [list $fd $script]
  48 }
  49
  50 proc nukefile {fd} {
  51     global runq
  52
  53     for {set i 0} {$i < [llength $runq]} {} {
  54         if {[lindex $runq $i 0] eq $fd} {
  55             set runq [lreplace $runq $i $i]
  56         } else {
  57             incr i
  58         }
  59     }
  60 }
  61
  62 proc dorunq {} {
  63     global isonrunq runq currunq
  64
  65     set tstart [clock clicks -milliseconds]
  66     set t0 $tstart
  67     while {[llength $runq] > 0} {
  68         set fd [lindex $runq 0 0]
  69         set script [lindex $runq 0 1]
  70         set currunq [lindex $runq 0]
  71         set runq [lrange $runq 1 end]
  72         set repeat [eval $script]
  73         unset currunq
  74         set t1 [clock clicks -milliseconds]
  75         set t [expr {$t1 - $t0}]
  76         if {$repeat ne {} && $repeat} {
  77             if {$fd eq {} || $repeat == 2} {
  78                 # script returns 1 if it wants to be readded
  79                 # file readers return 2 if they could do more straight away
  80                 lappend runq [list $fd $script]
  81             } else {
  82                 fileevent $fd readable [list filereadable $fd $script]
  83             }
  84         } elseif {$fd eq {}} {
  85             unset isonrunq($script)
  86         }
  87         set t0 $t1
  88         if {$t1 - $tstart >= 80} break
  89     }
  90     if {$runq ne {}} {
  91         after idle dorunq
  92     }
  93 }
  94
  95 proc reg_instance {fd} {
  96     global commfd leftover loginstance
  97
  98     set i [incr loginstance]
  99     set commfd($i) $fd
 100     set leftover($i) {}
 101     return $i
 102 }
 103
 104 proc unmerged_files {files} {
 105     global nr_unmerged
 106
 107     # find the list of unmerged files
 108     set mlist {}
 109     set nr_unmerged 0
 110     if {[catch {
 111         set fd [open "| git ls-files -u" r]
 112     } err]} {
 113         show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
 114         exit 1
 115     }
 116     while {[gets $fd line] >= 0} {
 117         set i [string first "\t" $line]
 118         if {$i < 0} continue
 119         set fname [string range $line [expr {$i+1}] end]
 120         if {[lsearch -exact $mlist $fname] >= 0} continue
 121         incr nr_unmerged
 122         if {$files eq {} || [path_filter $files $fname]} {
 123             lappend mlist $fname
 124         }
 125     }
 126     catch {close $fd}
 127     return $mlist
 128 }
 129
 130 proc parseviewargs {n arglist} {
 131     global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs
 132
 133     set vdatemode($n) 0
 134     set vmergeonly($n) 0
 135     set glflags {}
 136     set diffargs {}
 137     set nextisval 0
 138     set revargs {}
 139     set origargs $arglist
 140     set allknown 1
 141     set filtered 0
 142     set i -1
 143     foreach arg $arglist {
 144         incr i
 145         if {$nextisval} {
 146             lappend glflags $arg
 147             set nextisval 0
 148             continue
 149         }
 150         switch -glob -- $arg {
 151             "-d" -
 152             "--date-order" {
 153                 set vdatemode($n) 1
 154                 # remove from origargs in case we hit an unknown option
 155                 set origargs [lreplace $origargs $i $i]
 156                 incr i -1
 157             }
 158             # These request or affect diff output, which we don't want.
 159             # Some could be used to set our defaults for diff display.
 160             "-[puabwcrRBMC]" -
 161             "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
 162             "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
 163             "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
 164             "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
 165             "--ignore-space-change" - "-U*" - "--unified=*" {
 166                 lappend diffargs $arg
 167             }
 168             # These cause our parsing of git log's output to fail, or else
 169             # they're options we want to set ourselves, so ignore them.
 170             "--raw" - "--patch-with-raw" - "--patch-with-stat" -
 171             "--name-only" - "--name-status" - "--color" - "--color-words" -
 172             "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
 173             "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
 174             "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
 175             "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
 176             "--objects" - "--objects-edge" - "--reverse" {
 177             }
 178             # These are harmless, and some are even useful
 179             "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
 180             "--check" - "--exit-code" - "--quiet" - "--topo-order" -
 181             "--full-history" - "--dense" - "--sparse" -
 182             "--follow" - "--left-right" - "--encoding=*" {
 183                 lappend glflags $arg
 184             }
 185             # These mean that we get a subset of the commits
 186             "--diff-filter=*" - "--no-merges" - "--unpacked" -
 187             "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
 188             "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
 189             "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
 190             "--remove-empty" - "--first-parent" - "--cherry-pick" -
 191             "-S*" - "--pickaxe-all" - "--pickaxe-regex" - {
 192                 set filtered 1
 193                 lappend glflags $arg
 194             }
 195             # This appears to be the only one that has a value as a
 196             # separate word following it
 197             "-n" {
 198                 set filtered 1
 199                 set nextisval 1
 200                 lappend glflags $arg
 201             }
 202             "--not" {
 203                 set notflag [expr {!$notflag}]
 204                 lappend revargs $arg
 205             }
 206             "--all" {
 207                 lappend revargs $arg
 208             }
 209             "--merge" {
 210                 set vmergeonly($n) 1
 211                 # git rev-parse doesn't understand --merge
 212                 lappend revargs --gitk-symmetric-diff-marker MERGE_HEAD...HEAD
 213             }
 214             # Other flag arguments including -<n>
 215             "-*" {
 216                 if {[string is digit -strict [string range $arg 1 end]]} {
 217                     set filtered 1
 218                 } else {
 219                     # a flag argument that we don't recognize;
 220                     # that means we can't optimize
 221                     set allknown 0
 222                 }
 223                 lappend glflags $arg
 224             }
 225             # Non-flag arguments specify commits or ranges of commits
 226             default {
 227                 if {[string match "*...*" $arg]} {
 228                     lappend revargs --gitk-symmetric-diff-marker
 229                 }
 230                 lappend revargs $arg
 231             }
 232         }
 233     }
 234     set vdflags($n) $diffargs
 235     set vflags($n) $glflags
 236     set vrevs($n) $revargs
 237     set vfiltered($n) $filtered
 238     set vorigargs($n) $origargs
 239     return $allknown
 240 }
 241
 242 proc parseviewrevs {view revs} {
 243     global vposids vnegids
 244
 245     if {$revs eq {}} {
 246         set revs HEAD
 247     }
 248     if {[catch {set ids [eval exec git rev-parse $revs]} err]} {
 249         # we get stdout followed by stderr in $err
 250         # for an unknown rev, git rev-parse echoes it and then errors out
 251         set errlines [split $err "\n"]
 252         set badrev {}
 253         for {set l 0} {$l < [llength $errlines]} {incr l} {
 254             set line [lindex $errlines $l]
 255             if {!([string length $line] == 40 && [string is xdigit $line])} {
 256                 if {[string match "fatal:*" $line]} {
 257                     if {[string match "fatal: ambiguous argument*" $line]
 258                         && $badrev ne {}} {
 259                         if {[llength $badrev] == 1} {
 260                             set err "unknown revision $badrev"
 261                         } else {
 262                             set err "unknown revisions: [join $badrev ", "]"
 263                         }
 264                     } else {
 265                         set err [join [lrange $errlines $l end] "\n"]
 266                     }
 267                     break
 268                 }
 269                 lappend badrev $line
 270             }
 271         }
 272         error_popup "[mc "Error parsing revisions:"] $err"
 273         return {}
 274     }
 275     set ret {}
 276     set pos {}
 277     set neg {}
 278     set sdm 0
 279     foreach id [split $ids "\n"] {
 280         if {$id eq "--gitk-symmetric-diff-marker"} {
 281             set sdm 4
 282         } elseif {[string match "^*" $id]} {
 283             if {$sdm != 1} {
 284                 lappend ret $id
 285                 if {$sdm == 3} {
 286                     set sdm 0
 287                 }
 288             }
 289             lappend neg [string range $id 1 end]
 290         } else {
 291             if {$sdm != 2} {
 292                 lappend ret $id
 293             } else {
 294                 lset ret end [lindex $ret end]...$id
 295             }
 296             lappend pos $id
 297         }
 298         incr sdm -1
 299     }
 300     set vposids($view) $pos
 301     set vnegids($view) $neg
 302     return $ret
 303 }
 304
 305 # Start off a git log process and arrange to read its output
 306 proc start_rev_list {view} {
 307     global startmsecs commitidx viewcomplete curview
 308     global tclencoding
 309     global viewargs viewargscmd viewfiles vfilelimit
 310     global showlocalchanges
 311     global viewactive viewinstances vmergeonly
 312     global mainheadid
 313     global vcanopt vflags vrevs vorigargs
 314
 315     set startmsecs [clock clicks -milliseconds]
 316     set commitidx($view) 0
 317     # these are set this way for the error exits
 318     set viewcomplete($view) 1
 319     set viewactive($view) 0
 320     varcinit $view
 321
 322     set args $viewargs($view)
 323     if {$viewargscmd($view) ne {}} {
 324         if {[catch {
 325             set str [exec sh -c $viewargscmd($view)]
 326         } err]} {
 327             error_popup "[mc "Error executing --argscmd command:"] $err"
 328             return 0
 329         }
 330         set args [concat $args [split $str "\n"]]
 331     }
 332     set vcanopt($view) [parseviewargs $view $args]
 333
 334     set files $viewfiles($view)
 335     if {$vmergeonly($view)} {
 336         set files [unmerged_files $files]
 337         if {$files eq {}} {
 338             global nr_unmerged
 339             if {$nr_unmerged == 0} {
 340                 error_popup [mc "No files selected: --merge specified but\
 341                              no files are unmerged."]
 342             } else {
 343                 error_popup [mc "No files selected: --merge specified but\
 344                              no unmerged files are within file limit."]
 345             }
 346             return 0
 347         }
 348     }
 349     set vfilelimit($view) $files
 350
 351     if {$vcanopt($view)} {
 352         set revs [parseviewrevs $view $vrevs($view)]
 353         if {$revs eq {}} {
 354             return 0
 355         }
 356         set args [concat $vflags($view) $revs]
 357     } else {
 358         set args $vorigargs($view)
 359     }
 360
 361     if {[catch {
 362         set fd [open [concat | git log --no-color -z --pretty=raw --parents \
 363                          --boundary $args "--" $files] r]
 364     } err]} {
 365         error_popup "[mc "Error executing git log:"] $err"
 366         return 0
 367     }
 368     set i [reg_instance $fd]
 369     set viewinstances($view) [list $i]
 370     if {$showlocalchanges && $mainheadid ne {}} {
 371         interestedin $mainheadid dodiffindex
 372     }
 373     fconfigure $fd -blocking 0 -translation lf -eofchar {}
 374     if {$tclencoding != {}} {
 375         fconfigure $fd -encoding $tclencoding
 376     }
 377     filerun $fd [list getcommitlines $fd $i $view 0]
 378     nowbusy $view [mc "Reading"]
 379     set viewcomplete($view) 0
 380     set viewactive($view) 1
 381     return 1
 382 }
 383
 384 proc stop_instance {inst} {
 385     global commfd leftover
 386
 387     set fd $commfd($inst)
 388     catch {
 389         set pid [pid $fd]
 390
 391         if {$::tcl_platform(platform) eq {windows}} {
 392             exec kill -f $pid
 393         } else {
 394             exec kill $pid
 395         }
 396     }
 397     catch {close $fd}
 398     nukefile $fd
 399     unset commfd($inst)
 400     unset leftover($inst)
 401 }
 402
 403 proc stop_backends {} {
 404     global commfd
 405
 406     foreach inst [array names commfd] {
 407         stop_instance $inst
 408     }
 409 }
 410
 411 proc stop_rev_list {view} {
 412     global viewinstances
 413
 414     foreach inst $viewinstances($view) {
 415         stop_instance $inst
 416     }
 417     set viewinstances($view) {}
 418 }
 419
 420 proc reset_pending_select {selid} {
 421     global pending_select mainheadid selectheadid
 422
 423     if {$selid ne {}} {
 424         set pending_select $selid
 425     } elseif {$selectheadid ne {}} {
 426         set pending_select $selectheadid
 427     } else {
 428         set pending_select $mainheadid
 429     }
 430 }
 431
 432 proc getcommits {selid} {
 433     global canv curview need_redisplay viewactive
 434
 435     initlayout
 436     if {[start_rev_list $curview]} {
 437         reset_pending_select $selid
 438         show_status [mc "Reading commits..."]
 439         set need_redisplay 1
 440     } else {
 441         show_status [mc "No commits selected"]
 442     }
 443 }
 444
 445 proc updatecommits {} {
 446     global curview vcanopt vorigargs vfilelimit viewinstances
 447     global viewactive viewcomplete tclencoding
 448     global startmsecs showneartags showlocalchanges
 449     global mainheadid pending_select
 450     global isworktree
 451     global varcid vposids vnegids vflags vrevs
 452
 453     set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
 454     set oldmainid $mainheadid
 455     rereadrefs
 456     if {$showlocalchanges} {
 457         if {$mainheadid ne $oldmainid} {
 458             dohidelocalchanges
 459         }
 460         if {[commitinview $mainheadid $curview]} {
 461             dodiffindex
 462         }
 463     }
 464     set view $curview
 465     if {$vcanopt($view)} {
 466         set oldpos $vposids($view)
 467         set oldneg $vnegids($view)
 468         set revs [parseviewrevs $view $vrevs($view)]
 469         if {$revs eq {}} {
 470             return
 471         }
 472         # note: getting the delta when negative refs change is hard,
 473         # and could require multiple git log invocations, so in that
 474         # case we ask git log for all the commits (not just the delta)
 475         if {$oldneg eq $vnegids($view)} {
 476             set newrevs {}
 477             set npos 0
 478             # take out positive refs that we asked for before or
 479             # that we have already seen
 480             foreach rev $revs {
 481                 if {[string length $rev] == 40} {
 482                     if {[lsearch -exact $oldpos $rev] < 0
 483                         && ![info exists varcid($view,$rev)]} {
 484                         lappend newrevs $rev
 485                         incr npos
 486                     }
 487                 } else {
 488                     lappend $newrevs $rev
 489                 }
 490             }
 491             if {$npos == 0} return
 492             set revs $newrevs
 493             set vposids($view) [lsort -unique [concat $oldpos $vposids($view)]]
 494         }
 495         set args [concat $vflags($view) $revs --not $oldpos]
 496     } else {
 497         set args $vorigargs($view)
 498     }
 499     if {[catch {
 500         set fd [open [concat | git log --no-color -z --pretty=raw --parents \
 501                           --boundary $args "--" $vfilelimit($view)] r]
 502     } err]} {
 503         error_popup "[mc "Error executing git log:"] $err"
 504         return
 505     }
 506     if {$viewactive($view) == 0} {
 507         set startmsecs [clock clicks -milliseconds]
 508     }
 509     set i [reg_instance $fd]
 510     lappend viewinstances($view) $i
 511     fconfigure $fd -blocking 0 -translation lf -eofchar {}
 512     if {$tclencoding != {}} {
 513         fconfigure $fd -encoding $tclencoding
 514     }
 515     filerun $fd [list getcommitlines $fd $i $view 1]
 516     incr viewactive($view)
 517     set viewcomplete($view) 0
 518     reset_pending_select {}
 519     nowbusy $view "Reading"
 520     if {$showneartags} {
 521         getallcommits
 522     }
 523 }
 524
 525 proc reloadcommits {} {
 526     global curview viewcomplete selectedline currentid thickerline
 527     global showneartags treediffs commitinterest cached_commitrow
 528     global targetid
 529
 530     set selid {}
 531     if {$selectedline ne {}} {
 532         set selid $currentid
 533     }
 534
 535     if {!$viewcomplete($curview)} {
 536         stop_rev_list $curview
 537     }
 538     resetvarcs $curview
 539     set selectedline {}
 540     catch {unset currentid}
 541     catch {unset thickerline}
 542     catch {unset treediffs}
 543     readrefs
 544     changedrefs
 545     if {$showneartags} {
 546         getallcommits
 547     }
 548     clear_display
 549     catch {unset commitinterest}
 550     catch {unset cached_commitrow}
 551     catch {unset targetid}
 552     setcanvscroll
 553     getcommits $selid
 554     return 0
 555 }
 556
 557 # This makes a string representation of a positive integer which
 558 # sorts as a string in numerical order
 559 proc strrep {n} {
 560     if {$n < 16} {
 561         return [format "%x" $n]
 562     } elseif {$n < 256} {
 563         return [format "x%.2x" $n]
 564     } elseif {$n < 65536} {
 565         return [format "y%.4x" $n]
 566     }
 567     return [format "z%.8x" $n]
 568 }
 569
 570 # Procedures used in reordering commits from git log (without
 571 # --topo-order) into the order for display.
 572
 573 proc varcinit {view} {
 574     global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
 575     global vtokmod varcmod vrowmod varcix vlastins
 576
 577     set varcstart($view) {{}}
 578     set vupptr($view) {0}
 579     set vdownptr($view) {0}
 580     set vleftptr($view) {0}
 581     set vbackptr($view) {0}
 582     set varctok($view) {{}}
 583     set varcrow($view) {{}}
 584     set vtokmod($view) {}
 585     set varcmod($view) 0
 586     set vrowmod($view) 0
 587     set varcix($view) {{}}
 588     set vlastins($view) {0}
 589 }
 590
 591 proc resetvarcs {view} {
 592     global varcid varccommits parents children vseedcount ordertok
 593
 594     foreach vid [array names varcid $view,*] {
 595         unset varcid($vid)
 596         unset children($vid)
 597         unset parents($vid)
 598     }
 599     # some commits might have children but haven't been seen yet
 600     foreach vid [array names children $view,*] {
 601         unset children($vid)
 602     }
 603     foreach va [array names varccommits $view,*] {
 604         unset varccommits($va)
 605     }
 606     foreach vd [array names vseedcount $view,*] {
 607         unset vseedcount($vd)
 608     }
 609     catch {unset ordertok}
 610 }
 611
 612 # returns a list of the commits with no children
 613 proc seeds {v} {
 614     global vdownptr vleftptr varcstart
 615
 616     set ret {}
 617     set a [lindex $vdownptr($v) 0]
 618     while {$a != 0} {
 619         lappend ret [lindex $varcstart($v) $a]
 620         set a [lindex $vleftptr($v) $a]
 621     }
 622     return $ret
 623 }
 624
 625 proc newvarc {view id} {
 626     global varcid varctok parents children vdatemode
 627     global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
 628     global commitdata commitinfo vseedcount varccommits vlastins
 629
 630     set a [llength $varctok($view)]
 631     set vid $view,$id
 632     if {[llength $children($vid)] == 0 || $vdatemode($view)} {
 633         if {![info exists commitinfo($id)]} {
 634             parsecommit $id $commitdata($id) 1
 635         }
 636         set cdate [lindex $commitinfo($id) 4]
 637         if {![string is integer -strict $cdate]} {
 638             set cdate 0
 639         }
 640         if {![info exists vseedcount($view,$cdate)]} {
 641             set vseedcount($view,$cdate) -1
 642         }
 643         set c [incr vseedcount($view,$cdate)]
 644         set cdate [expr {$cdate ^ 0xffffffff}]
 645         set tok "s[strrep $cdate][strrep $c]"
 646     } else {
 647         set tok {}
 648     }
 649     set ka 0
 650     if {[llength $children($vid)] > 0} {
 651         set kid [lindex $children($vid) end]
 652         set k $varcid($view,$kid)
 653         if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
 654             set ki $kid
 655             set ka $k
 656             set tok [lindex $varctok($view) $k]
 657         }
 658     }
 659     if {$ka != 0} {
 660         set i [lsearch -exact $parents($view,$ki) $id]
 661         set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
 662         append tok [strrep $j]
 663     }
 664     set c [lindex $vlastins($view) $ka]
 665     if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
 666         set c $ka
 667         set b [lindex $vdownptr($view) $ka]
 668     } else {
 669         set b [lindex $vleftptr($view) $c]
 670     }
 671     while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
 672         set c $b
 673         set b [lindex $vleftptr($view) $c]
 674     }
 675     if {$c == $ka} {
 676         lset vdownptr($view) $ka $a
 677         lappend vbackptr($view) 0
 678     } else {
 679         lset vleftptr($view) $c $a
 680         lappend vbackptr($view) $c
 681     }
 682     lset vlastins($view) $ka $a
 683     lappend vupptr($view) $ka
 684     lappend vleftptr($view) $b
 685     if {$b != 0} {
 686         lset vbackptr($view) $b $a
 687     }
 688     lappend varctok($view) $tok
 689     lappend varcstart($view) $id
 690     lappend vdownptr($view) 0
 691     lappend varcrow($view) {}
 692     lappend varcix($view) {}
 693     set varccommits($view,$a) {}
 694     lappend vlastins($view) 0
 695     return $a
 696 }
 697
 698 proc splitvarc {p v} {
 699     global varcid varcstart varccommits varctok
 700     global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
 701
 702     set oa $varcid($v,$p)
 703     set ac $varccommits($v,$oa)
 704     set i [lsearch -exact $varccommits($v,$oa) $p]
 705     if {$i <= 0} return
 706     set na [llength $varctok($v)]
 707     # "%" sorts before "0"...
 708     set tok "[lindex $varctok($v) $oa]%[strrep $i]"
 709     lappend varctok($v) $tok
 710     lappend varcrow($v) {}
 711     lappend varcix($v) {}
 712     set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
 713     set varccommits($v,$na) [lrange $ac $i end]
 714     lappend varcstart($v) $p
 715     foreach id $varccommits($v,$na) {
 716         set varcid($v,$id) $na
 717     }
 718     lappend vdownptr($v) [lindex $vdownptr($v) $oa]
 719     lappend vlastins($v) [lindex $vlastins($v) $oa]
 720     lset vdownptr($v) $oa $na
 721     lset vlastins($v) $oa 0
 722     lappend vupptr($v) $oa
 723     lappend vleftptr($v) 0
 724     lappend vbackptr($v) 0
 725     for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
 726         lset vupptr($v) $b $na
 727     }
 728 }
 729
 730 proc renumbervarc {a v} {
 731     global parents children varctok varcstart varccommits
 732     global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
 733
 734     set t1 [clock clicks -milliseconds]
 735     set todo {}
 736     set isrelated($a) 1
 737     set kidchanged($a) 1
 738     set ntot 0
 739     while {$a != 0} {
 740         if {[info exists isrelated($a)]} {
 741             lappend todo $a
 742             set id [lindex $varccommits($v,$a) end]
 743             foreach p $parents($v,$id) {
 744                 if {[info exists varcid($v,$p)]} {
 745                     set isrelated($varcid($v,$p)) 1
 746                 }
 747             }
 748         }
 749         incr ntot
 750         set b [lindex $vdownptr($v) $a]
 751         if {$b == 0} {
 752             while {$a != 0} {
 753                 set b [lindex $vleftptr($v) $a]
 754                 if {$b != 0} break
 755                 set a [lindex $vupptr($v) $a]
 756             }
 757         }
 758         set a $b
 759     }
 760     foreach a $todo {
 761         if {![info exists kidchanged($a)]} continue
 762         set id [lindex $varcstart($v) $a]
 763         if {[llength $children($v,$id)] > 1} {
 764             set children($v,$id) [lsort -command [list vtokcmp $v] \
 765                                       $children($v,$id)]
 766         }
 767         set oldtok [lindex $varctok($v) $a]
 768         if {!$vdatemode($v)} {
 769             set tok {}
 770         } else {
 771             set tok $oldtok
 772         }
 773         set ka 0
 774         set kid [last_real_child $v,$id]
 775         if {$kid ne {}} {
 776             set k $varcid($v,$kid)
 777             if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
 778                 set ki $kid
 779                 set ka $k
 780                 set tok [lindex $varctok($v) $k]
 781             }
 782         }
 783         if {$ka != 0} {
 784             set i [lsearch -exact $parents($v,$ki) $id]
 785             set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
 786             append tok [strrep $j]
 787         }
 788         if {$tok eq $oldtok} {
 789             continue
 790         }
 791         set id [lindex $varccommits($v,$a) end]
 792         foreach p $parents($v,$id) {
 793             if {[info exists varcid($v,$p)]} {
 794                 set kidchanged($varcid($v,$p)) 1
 795             } else {
 796                 set sortkids($p) 1
 797             }
 798         }
 799         lset varctok($v) $a $tok
 800         set b [lindex $vupptr($v) $a]
 801         if {$b != $ka} {
 802             if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
 803                 modify_arc $v $ka
 804             }
 805             if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
 806                 modify_arc $v $b
 807             }
 808             set c [lindex $vbackptr($v) $a]
 809             set d [lindex $vleftptr($v) $a]
 810             if {$c == 0} {
 811                 lset vdownptr($v) $b $d
 812             } else {
 813                 lset vleftptr($v) $c $d
 814             }
 815             if {$d != 0} {
 816                 lset vbackptr($v) $d $c
 817             }
 818             if {[lindex $vlastins($v) $b] == $a} {
 819                 lset vlastins($v) $b $c
 820             }
 821             lset vupptr($v) $a $ka
 822             set c [lindex $vlastins($v) $ka]
 823             if {$c == 0 || \
 824                     [string compare $tok [lindex $varctok($v) $c]] < 0} {
 825                 set c $ka
 826                 set b [lindex $vdownptr($v) $ka]
 827             } else {
 828                 set b [lindex $vleftptr($v) $c]
 829             }
 830             while {$b != 0 && \
 831                       [string compare $tok [lindex $varctok($v) $b]] >= 0} {
 832                 set c $b
 833                 set b [lindex $vleftptr($v) $c]
 834             }
 835             if {$c == $ka} {
 836                 lset vdownptr($v) $ka $a
 837                 lset vbackptr($v) $a 0
 838             } else {
 839                 lset vleftptr($v) $c $a
 840                 lset vbackptr($v) $a $c
 841             }
 842             lset vleftptr($v) $a $b
 843             if {$b != 0} {
 844                 lset vbackptr($v) $b $a
 845             }
 846             lset vlastins($v) $ka $a
 847         }
 848     }
 849     foreach id [array names sortkids] {
 850         if {[llength $children($v,$id)] > 1} {
 851             set children($v,$id) [lsort -command [list vtokcmp $v] \
 852                                       $children($v,$id)]
 853         }
 854     }
 855     set t2 [clock clicks -milliseconds]
 856     #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
 857 }
 858
 859 # Fix up the graph after we have found out that in view $v,
 860 # $p (a commit that we have already seen) is actually the parent
 861 # of the last commit in arc $a.
 862 proc fix_reversal {p a v} {
 863     global varcid varcstart varctok vupptr
 864
 865     set pa $varcid($v,$p)
 866     if {$p ne [lindex $varcstart($v) $pa]} {
 867         splitvarc $p $v
 868         set pa $varcid($v,$p)
 869     }
 870     # seeds always need to be renumbered
 871     if {[lindex $vupptr($v) $pa] == 0 ||
 872         [string compare [lindex $varctok($v) $a] \
 873              [lindex $varctok($v) $pa]] > 0} {
 874         renumbervarc $pa $v
 875     }
 876 }
 877
 878 proc insertrow {id p v} {
 879     global cmitlisted children parents varcid varctok vtokmod
 880     global varccommits ordertok commitidx numcommits curview
 881     global targetid targetrow
 882
 883     readcommit $id
 884     set vid $v,$id
 885     set cmitlisted($vid) 1
 886     set children($vid) {}
 887     set parents($vid) [list $p]
 888     set a [newvarc $v $id]
 889     set varcid($vid) $a
 890     if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
 891         modify_arc $v $a
 892     }
 893     lappend varccommits($v,$a) $id
 894     set vp $v,$p
 895     if {[llength [lappend children($vp) $id]] > 1} {
 896         set children($vp) [lsort -command [list vtokcmp $v] $children($vp)]
 897         catch {unset ordertok}
 898     }
 899     fix_reversal $p $a $v
 900     incr commitidx($v)
 901     if {$v == $curview} {
 902         set numcommits $commitidx($v)
 903         setcanvscroll
 904         if {[info exists targetid]} {
 905             if {![comes_before $targetid $p]} {
 906                 incr targetrow
 907             }
 908         }
 909     }
 910 }
 911
 912 proc insertfakerow {id p} {
 913     global varcid varccommits parents children cmitlisted
 914     global commitidx varctok vtokmod targetid targetrow curview numcommits
 915
 916     set v $curview
 917     set a $varcid($v,$p)
 918     set i [lsearch -exact $varccommits($v,$a) $p]
 919     if {$i < 0} {
 920         puts "oops: insertfakerow can't find [shortids $p] on arc $a"
 921         return
 922     }
 923     set children($v,$id) {}
 924     set parents($v,$id) [list $p]
 925     set varcid($v,$id) $a
 926     lappend children($v,$p) $id
 927     set cmitlisted($v,$id) 1
 928     set numcommits [incr commitidx($v)]
 929     # note we deliberately don't update varcstart($v) even if $i == 0
 930     set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
 931     modify_arc $v $a $i
 932     if {[info exists targetid]} {
 933         if {![comes_before $targetid $p]} {
 934             incr targetrow
 935         }
 936     }
 937     setcanvscroll
 938     drawvisible
 939 }
 940
 941 proc removefakerow {id} {
 942     global varcid varccommits parents children commitidx
 943     global varctok vtokmod cmitlisted currentid selectedline
 944     global targetid curview numcommits
 945
 946     set v $curview
 947     if {[llength $parents($v,$id)] != 1} {
 948         puts "oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
 949         return
 950     }
 951     set p [lindex $parents($v,$id) 0]
 952     set a $varcid($v,$id)
 953     set i [lsearch -exact $varccommits($v,$a) $id]
 954     if {$i < 0} {
 955         puts "oops: removefakerow can't find [shortids $id] on arc $a"
 956         return
 957     }
 958     unset varcid($v,$id)
 959     set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
 960     unset parents($v,$id)
 961     unset children($v,$id)
 962     unset cmitlisted($v,$id)
 963     set numcommits [incr commitidx($v) -1]
 964     set j [lsearch -exact $children($v,$p) $id]
 965     if {$j >= 0} {
 966         set children($v,$p) [lreplace $children($v,$p) $j $j]
 967     }
 968     modify_arc $v $a $i
 969     if {[info exist currentid] && $id eq $currentid} {
 970         unset currentid
 971         set selectedline {}
 972     }
 973     if {[info exists targetid] && $targetid eq $id} {
 974         set targetid $p
 975     }
 976     setcanvscroll
 977     drawvisible
 978 }
 979
 980 proc first_real_child {vp} {
 981     global children nullid nullid2
 982
 983     foreach id $children($vp) {
 984         if {$id ne $nullid && $id ne $nullid2} {
 985             return $id
 986         }
 987     }
 988     return {}
 989 }
 990
 991 proc last_real_child {vp} {
 992     global children nullid nullid2
 993
 994     set kids $children($vp)
 995     for {set i [llength $kids]} {[incr i -1] >= 0} {} {
 996         set id [lindex $kids $i]
 997         if {$id ne $nullid && $id ne $nullid2} {
 998             return $id
 999         }
1000     }
1001     return {}
1002 }
1003
1004 proc vtokcmp {v a b} {
1005     global varctok varcid
1006
1007     return [string compare [lindex $varctok($v) $varcid($v,$a)] \
1008                 [lindex $varctok($v) $varcid($v,$b)]]
1009 }
1010
1011 # This assumes that if lim is not given, the caller has checked that
1012 # arc a's token is less than $vtokmod($v)
1013 proc modify_arc {v a {lim {}}} {
1014     global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
1015
1016     if {$lim ne {}} {
1017         set c [string compare [lindex $varctok($v) $a] $vtokmod($v)]
1018         if {$c > 0} return
1019         if {$c == 0} {
1020             set r [lindex $varcrow($v) $a]
1021             if {$r ne {} && $vrowmod($v) <= $r + $lim} return
1022         }
1023     }
1024     set vtokmod($v) [lindex $varctok($v) $a]
1025     set varcmod($v) $a
1026     if {$v == $curview} {
1027         while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
1028             set a [lindex $vupptr($v) $a]
1029             set lim {}
1030         }
1031         set r 0
1032         if {$a != 0} {
1033             if {$lim eq {}} {
1034                 set lim [llength $varccommits($v,$a)]
1035             }
1036             set r [expr {[lindex $varcrow($v) $a] + $lim}]
1037         }
1038         set vrowmod($v) $r
1039         undolayout $r
1040     }
1041 }
1042
1043 proc update_arcrows {v} {
1044     global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
1045     global varcid vrownum varcorder varcix varccommits
1046     global vupptr vdownptr vleftptr varctok
1047     global displayorder parentlist curview cached_commitrow
1048
1049     if {$vrowmod($v) == $commitidx($v)} return
1050     if {$v == $curview} {
1051         if {[llength $displayorder] > $vrowmod($v)} {
1052             set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
1053             set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
1054         }
1055         catch {unset cached_commitrow}
1056     }
1057     set narctot [expr {[llength $varctok($v)] - 1}]
1058     set a $varcmod($v)
1059     while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
1060         # go up the tree until we find something that has a row number,
1061         # or we get to a seed
1062         set a [lindex $vupptr($v) $a]
1063     }
1064     if {$a == 0} {
1065         set a [lindex $vdownptr($v) 0]
1066         if {$a == 0} return
1067         set vrownum($v) {0}
1068         set varcorder($v) [list $a]
1069         lset varcix($v) $a 0
1070         lset varcrow($v) $a 0
1071         set arcn 0
1072         set row 0
1073     } else {
1074         set arcn [lindex $varcix($v) $a]
1075         if {[llength $vrownum($v)] > $arcn + 1} {
1076             set vrownum($v) [lrange $vrownum($v) 0 $arcn]
1077             set varcorder($v) [lrange $varcorder($v) 0 $arcn]
1078         }
1079         set row [lindex $varcrow($v) $a]
1080     }
1081     while {1} {
1082         set p $a
1083         incr row [llength $varccommits($v,$a)]
1084         # go down if possible
1085         set b [lindex $vdownptr($v) $a]
1086         if {$b == 0} {
1087             # if not, go left, or go up until we can go left
1088             while {$a != 0} {
1089                 set b [lindex $vleftptr($v) $a]
1090                 if {$b != 0} break
1091                 set a [lindex $vupptr($v) $a]
1092             }
1093             if {$a == 0} break
1094         }
1095         set a $b
1096         incr arcn
1097         lappend vrownum($v) $row
1098         lappend varcorder($v) $a
1099         lset varcix($v) $a $arcn
1100         lset varcrow($v) $a $row
1101     }
1102     set vtokmod($v) [lindex $varctok($v) $p]
1103     set varcmod($v) $p
1104     set vrowmod($v) $row
1105     if {[info exists currentid]} {
1106         set selectedline [rowofcommit $currentid]
1107     }
1108 }
1109
1110 # Test whether view $v contains commit $id
1111 proc commitinview {id v} {
1112     global varcid
1113
1114     return [info exists varcid($v,$id)]
1115 }
1116
1117 # Return the row number for commit $id in the current view
1118 proc rowofcommit {id} {
1119     global varcid varccommits varcrow curview cached_commitrow
1120     global varctok vtokmod
1121
1122     set v $curview
1123     if {![info exists varcid($v,$id)]} {
1124         puts "oops rowofcommit no arc for [shortids $id]"
1125         return {}
1126     }
1127     set a $varcid($v,$id)
1128     if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
1129         update_arcrows $v
1130     }
1131     if {[info exists cached_commitrow($id)]} {
1132         return $cached_commitrow($id)
1133     }
1134     set i [lsearch -exact $varccommits($v,$a) $id]
1135     if {$i < 0} {
1136         puts "oops didn't find commit [shortids $id] in arc $a"
1137         return {}
1138     }
1139     incr i [lindex $varcrow($v) $a]
1140     set cached_commitrow($id) $i
1141     return $i
1142 }
1143
1144 # Returns 1 if a is on an earlier row than b, otherwise 0
1145 proc comes_before {a b} {
1146     global varcid varctok curview
1147
1148     set v $curview
1149     if {$a eq $b || ![info exists varcid($v,$a)] || \
1150             ![info exists varcid($v,$b)]} {
1151         return 0
1152     }
1153     if {$varcid($v,$a) != $varcid($v,$b)} {
1154         return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
1155                            [lindex $varctok($v) $varcid($v,$b)]] < 0}]
1156     }
1157     return [expr {[rowofcommit $a] < [rowofcommit $b]}]
1158 }
1159
1160 proc bsearch {l elt} {
1161     if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
1162         return 0
1163     }
1164     set lo 0
1165     set hi [llength $l]
1166     while {$hi - $lo > 1} {
1167         set mid [expr {int(($lo + $hi) / 2)}]
1168         set t [lindex $l $mid]
1169         if {$elt < $t} {
1170             set hi $mid
1171         } elseif {$elt > $t} {
1172             set lo $mid
1173         } else {
1174             return $mid
1175         }
1176     }
1177     return $lo
1178 }
1179
1180 # Make sure rows $start..$end-1 are valid in displayorder and parentlist
1181 proc make_disporder {start end} {
1182     global vrownum curview commitidx displayorder parentlist
1183     global varccommits varcorder parents vrowmod varcrow
1184     global d_valid_start d_valid_end
1185
1186     if {$end > $vrowmod($curview)} {
1187         update_arcrows $curview
1188     }
1189     set ai [bsearch $vrownum($curview) $start]
1190     set start [lindex $vrownum($curview) $ai]
1191     set narc [llength $vrownum($curview)]
1192     for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
1193         set a [lindex $varcorder($curview) $ai]
1194         set l [llength $displayorder]
1195         set al [llength $varccommits($curview,$a)]
1196         if {$l < $r + $al} {
1197             if {$l < $r} {
1198                 set pad [ntimes [expr {$r - $l}] {}]
1199                 set displayorder [concat $displayorder $pad]
1200                 set parentlist [concat $parentlist $pad]
1201             } elseif {$l > $r} {
1202                 set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
1203                 set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
1204             }
1205             foreach id $varccommits($curview,$a) {
1206                 lappend displayorder $id
1207                 lappend parentlist $parents($curview,$id)
1208             }
1209         } elseif {[lindex $displayorder [expr {$r + $al - 1}]] eq {}} {
1210             set i $r
1211             foreach id $varccommits($curview,$a) {
1212                 lset displayorder $i $id
1213                 lset parentlist $i $parents($curview,$id)
1214                 incr i
1215             }
1216         }
1217         incr r $al
1218     }
1219 }
1220
1221 proc commitonrow {row} {
1222     global displayorder
1223
1224     set id [lindex $displayorder $row]
1225     if {$id eq {}} {
1226         make_disporder $row [expr {$row + 1}]
1227         set id [lindex $displayorder $row]
1228     }
1229     return $id
1230 }
1231
1232 proc closevarcs {v} {
1233     global varctok varccommits varcid parents children
1234     global cmitlisted commitidx vtokmod
1235
1236     set missing_parents 0
1237     set scripts {}
1238     set narcs [llength $varctok($v)]
1239     for {set a 1} {$a < $narcs} {incr a} {
1240         set id [lindex $varccommits($v,$a) end]
1241         foreach p $parents($v,$id) {
1242             if {[info exists varcid($v,$p)]} continue
1243             # add p as a new commit
1244             incr missing_parents
1245             set cmitlisted($v,$p) 0
1246             set parents($v,$p) {}
1247             if {[llength $children($v,$p)] == 1 &&
1248                 [llength $parents($v,$id)] == 1} {
1249                 set b $a
1250             } else {
1251                 set b [newvarc $v $p]
1252             }
1253             set varcid($v,$p) $b
1254             if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
1255                 modify_arc $v $b
1256             }
1257             lappend varccommits($v,$b) $p
1258             incr commitidx($v)
1259             set scripts [check_interest $p $scripts]
1260         }
1261     }
1262     if {$missing_parents > 0} {
1263         foreach s $scripts {
1264             eval $s
1265         }
1266     }
1267 }
1268
1269 # Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1270 # Assumes we already have an arc for $rwid.
1271 proc rewrite_commit {v id rwid} {
1272     global children parents varcid varctok vtokmod varccommits
1273
1274     foreach ch $children($v,$id) {
1275         # make $rwid be $ch's parent in place of $id
1276         set i [lsearch -exact $parents($v,$ch) $id]
1277         if {$i < 0} {
1278             puts "oops rewrite_commit didn't find $id in parent list for $ch"
1279         }
1280         set parents($v,$ch) [lreplace $parents($v,$ch) $i $i $rwid]
1281         # add $ch to $rwid's children and sort the list if necessary
1282         if {[llength [lappend children($v,$rwid) $ch]] > 1} {
1283             set children($v,$rwid) [lsort -command [list vtokcmp $v] \
1284                                         $children($v,$rwid)]
1285         }
1286         # fix the graph after joining $id to $rwid
1287         set a $varcid($v,$ch)
1288         fix_reversal $rwid $a $v
1289         # parentlist is wrong for the last element of arc $a
1290         # even if displayorder is right, hence the 3rd arg here
1291         modify_arc $v $a [expr {[llength $varccommits($v,$a)] - 1}]
1292     }
1293 }
1294
1295 # Mechanism for registering a command to be executed when we come
1296 # across a particular commit.  To handle the case when only the
1297 # prefix of the commit is known, the commitinterest array is now
1298 # indexed by the first 4 characters of the ID.  Each element is a
1299 # list of id, cmd pairs.
1300 proc interestedin {id cmd} {
1301     global commitinterest
1302
1303     lappend commitinterest([string range $id 0 3]) $id $cmd
1304 }
1305
1306 proc check_interest {id scripts} {
1307     global commitinterest
1308
1309     set prefix [string range $id 0 3]
1310     if {[info exists commitinterest($prefix)]} {
1311         set newlist {}
1312         foreach {i script} $commitinterest($prefix) {
1313             if {[string match "$i*" $id]} {
1314                 lappend scripts [string map [list "%I" $id "%P" $i] $script]
1315             } else {
1316                 lappend newlist $i $script
1317             }
1318         }
1319         if {$newlist ne {}} {
1320             set commitinterest($prefix) $newlist
1321         } else {
1322             unset commitinterest($prefix)
1323         }
1324     }
1325     return $scripts
1326 }
1327
1328 proc getcommitlines {fd inst view updating}  {
1329     global cmitlisted leftover
1330     global commitidx commitdata vdatemode
1331     global parents children curview hlview
1332     global idpending ordertok
1333     global varccommits varcid varctok vtokmod vfilelimit
1334
1335     set stuff [read $fd 500000]
1336     # git log doesn't terminate the last commit with a null...
1337     if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
1338         set stuff "\0"
1339     }
1340     if {$stuff == {}} {
1341         if {![eof $fd]} {
1342             return 1
1343         }
1344         global commfd viewcomplete viewactive viewname
1345         global viewinstances
1346         unset commfd($inst)
1347         set i [lsearch -exact $viewinstances($view) $inst]
1348         if {$i >= 0} {
1349             set viewinstances($view) [lreplace $viewinstances($view) $i $i]
1350         }
1351         # set it blocking so we wait for the process to terminate
1352         fconfigure $fd -blocking 1
1353         if {[catch {close $fd} err]} {
1354             set fv {}
1355             if {$view != $curview} {
1356                 set fv " for the \"$viewname($view)\" view"
1357             }
1358             if {[string range $err 0 4] == "usage"} {
1359                 set err "Gitk: error reading commits$fv:\
1360                         bad arguments to git log."
1361                 if {$viewname($view) eq "Command line"} {
1362                     append err \
1363                         "  (Note: arguments to gitk are passed to git log\
1364                          to allow selection of commits to be displayed.)"
1365                 }
1366             } else {
1367                 set err "Error reading commits$fv: $err"
1368             }
1369             error_popup $err
1370         }
1371         if {[incr viewactive($view) -1] <= 0} {
1372             set viewcomplete($view) 1
1373             # Check if we have seen any ids listed as parents that haven't
1374             # appeared in the list
1375             closevarcs $view
1376             notbusy $view
1377         }
1378         if {$view == $curview} {
1379             run chewcommits
1380         }
1381         return 0
1382     }
1383     set start 0
1384     set gotsome 0
1385     set scripts {}
1386     while 1 {
1387         set i [string first "\0" $stuff $start]
1388         if {$i < 0} {
1389             append leftover($inst) [string range $stuff $start end]
1390             break
1391         }
1392         if {$start == 0} {
1393             set cmit $leftover($inst)
1394             append cmit [string range $stuff 0 [expr {$i - 1}]]
1395             set leftover($inst) {}
1396         } else {
1397             set cmit [string range $stuff $start [expr {$i - 1}]]
1398         }
1399         set start [expr {$i + 1}]
1400         set j [string first "\n" $cmit]
1401         set ok 0
1402         set listed 1
1403         if {$j >= 0 && [string match "commit *" $cmit]} {
1404             set ids [string range $cmit 7 [expr {$j - 1}]]
1405             if {[string match {[-^<>]*} $ids]} {
1406                 switch -- [string index $ids 0] {
1407                     "-" {set listed 0}
1408                     "^" {set listed 2}
1409                     "<" {set listed 3}
1410                     ">" {set listed 4}
1411                 }
1412                 set ids [string range $ids 1 end]
1413             }
1414             set ok 1
1415             foreach id $ids {
1416                 if {[string length $id] != 40} {
1417                     set ok 0
1418                     break
1419                 }
1420             }
1421         }
1422         if {!$ok} {
1423             set shortcmit $cmit
1424             if {[string length $shortcmit] > 80} {
1425                 set shortcmit "[string range $shortcmit 0 80]..."
1426             }
1427             error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
1428             exit 1
1429         }
1430         set id [lindex $ids 0]
1431         set vid $view,$id
1432
1433         if {!$listed && $updating && ![info exists varcid($vid)] &&
1434             $vfilelimit($view) ne {}} {
1435             # git log doesn't rewrite parents for unlisted commits
1436             # when doing path limiting, so work around that here
1437             # by working out the rewritten parent with git rev-list
1438             # and if we already know about it, using the rewritten
1439             # parent as a substitute parent for $id's children.
1440             if {![catch {
1441                 set rwid [exec git rev-list --first-parent --max-count=1 \
1442                               $id -- $vfilelimit($view)]
1443             }]} {
1444                 if {$rwid ne {} && [info exists varcid($view,$rwid)]} {
1445                     # use $rwid in place of $id
1446                     rewrite_commit $view $id $rwid
1447                     continue
1448                 }
1449             }
1450         }
1451
1452         set a 0
1453         if {[info exists varcid($vid)]} {
1454             if {$cmitlisted($vid) || !$listed} continue
1455             set a $varcid($vid)
1456         }
1457         if {$listed} {
1458             set olds [lrange $ids 1 end]
1459         } else {
1460             set olds {}
1461         }
1462         set commitdata($id) [string range $cmit [expr {$j + 1}] end]
1463         set cmitlisted($vid) $listed
1464         set parents($vid) $olds
1465         if {![info exists children($vid)]} {
1466             set children($vid) {}
1467         } elseif {$a == 0 && [llength $children($vid)] == 1} {
1468             set k [lindex $children($vid) 0]
1469             if {[llength $parents($view,$k)] == 1 &&
1470                 (!$vdatemode($view) ||
1471                  $varcid($view,$k) == [llength $varctok($view)] - 1)} {
1472                 set a $varcid($view,$k)
1473             }
1474         }
1475         if {$a == 0} {
1476             # new arc
1477             set a [newvarc $view $id]
1478         }
1479         if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
1480             modify_arc $view $a
1481         }
1482         if {![info exists varcid($vid)]} {
1483             set varcid($vid) $a
1484             lappend varccommits($view,$a) $id
1485             incr commitidx($view)
1486         }
1487
1488         set i 0
1489         foreach p $olds {
1490             if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
1491                 set vp $view,$p
1492                 if {[llength [lappend children($vp) $id]] > 1 &&
1493                     [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
1494                     set children($vp) [lsort -command [list vtokcmp $view] \
1495                                            $children($vp)]
1496                     catch {unset ordertok}
1497                 }
1498                 if {[info exists varcid($view,$p)]} {
1499                     fix_reversal $p $a $view
1500                 }
1501             }
1502             incr i
1503         }
1504
1505         set scripts [check_interest $id $scripts]
1506         set gotsome 1
1507     }
1508     if {$gotsome} {
1509         global numcommits hlview
1510
1511         if {$view == $curview} {
1512             set numcommits $commitidx($view)
1513             run chewcommits
1514         }
1515         if {[info exists hlview] && $view == $hlview} {
1516             # we never actually get here...
1517             run vhighlightmore
1518         }
1519         foreach s $scripts {
1520             eval $s
1521         }
1522     }
1523     return 2
1524 }
1525
1526 proc chewcommits {} {
1527     global curview hlview viewcomplete
1528     global pending_select
1529
1530     layoutmore
1531     if {$viewcomplete($curview)} {
1532         global commitidx varctok
1533         global numcommits startmsecs
1534
1535         if {[info exists pending_select]} {
1536             update
1537             reset_pending_select {}
1538
1539             if {[commitinview $pending_select $curview]} {
1540                 selectline [rowofcommit $pending_select] 1
1541             } else {
1542                 set row [first_real_row]
1543                 selectline $row 1
1544             }
1545         }
1546         if {$commitidx($curview) > 0} {
1547             #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1548             #puts "overall $ms ms for $numcommits commits"
1549             #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1550         } else {
1551             show_status [mc "No commits selected"]
1552         }
1553         notbusy layout
1554     }
1555     return 0
1556 }
1557
1558 proc readcommit {id} {
1559     if {[catch {set contents [exec git cat-file commit $id]}]} return
1560     parsecommit $id $contents 0
1561 }
1562
1563 proc parsecommit {id contents listed} {
1564     global commitinfo cdate
1565
1566     set inhdr 1
1567     set comment {}
1568     set headline {}
1569     set auname {}
1570     set audate {}
1571     set comname {}
1572     set comdate {}
1573     set hdrend [string first "\n\n" $contents]
1574     if {$hdrend < 0} {
1575         # should never happen...
1576         set hdrend [string length $contents]
1577     }
1578     set header [string range $contents 0 [expr {$hdrend - 1}]]
1579     set comment [string range $contents [expr {$hdrend + 2}] end]
1580     foreach line [split $header "\n"] {
1581         set tag [lindex $line 0]
1582         if {$tag == "author"} {
1583             set audate [lindex $line end-1]
1584             set auname [lrange $line 1 end-2]
1585         } elseif {$tag == "committer"} {
1586             set comdate [lindex $line end-1]
1587             set comname [lrange $line 1 end-2]
1588         }
1589     }
1590     set headline {}
1591     # take the first non-blank line of the comment as the headline
1592     set headline [string trimleft $comment]
1593     set i [string first "\n" $headline]
1594     if {$i >= 0} {
1595         set headline [string range $headline 0 $i]
1596     }
1597     set headline [string trimright $headline]
1598     set i [string first "\r" $headline]
1599     if {$i >= 0} {
1600         set headline [string trimright [string range $headline 0 $i]]
1601     }
1602     if {!$listed} {
1603         # git log indents the comment by 4 spaces;
1604         # if we got this via git cat-file, add the indentation
1605         set newcomment {}
1606         foreach line [split $comment "\n"] {
1607             append newcomment "    "
1608             append newcomment $line
1609             append newcomment "\n"
1610         }
1611         set comment $newcomment
1612     }
1613     if {$comdate != {}} {
1614         set cdate($id) $comdate
1615     }
1616     set commitinfo($id) [list $headline $auname $audate \
1617                              $comname $comdate $comment]
1618 }
1619
1620 proc getcommit {id} {
1621     global commitdata commitinfo
1622
1623     if {[info exists commitdata($id)]} {
1624         parsecommit $id $commitdata($id) 1
1625     } else {
1626         readcommit $id
1627         if {![info exists commitinfo($id)]} {
1628             set commitinfo($id) [list [mc "No commit information available"]]
1629         }
1630     }
1631     return 1
1632 }
1633
1634 # Expand an abbreviated commit ID to a list of full 40-char IDs that match
1635 # and are present in the current view.
1636 # This is fairly slow...
1637 proc longid {prefix} {
1638     global varcid curview
1639
1640     set ids {}
1641     foreach match [array names varcid "$curview,$prefix*"] {
1642         lappend ids [lindex [split $match ","] 1]
1643     }
1644     return $ids
1645 }
1646
1647 proc readrefs {} {
1648     global tagids idtags headids idheads tagobjid
1649     global otherrefids idotherrefs mainhead mainheadid
1650     global selecthead selectheadid
1651
1652     foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
1653         catch {unset $v}
1654     }
1655     set refd [open [list | git show-ref -d] r]
1656     while {[gets $refd line] >= 0} {
1657         if {[string index $line 40] ne " "} continue
1658         set id [string range $line 0 39]
1659         set ref [string range $line 41 end]
1660         if {![string match "refs/*" $ref]} continue
1661         set name [string range $ref 5 end]
1662         if {[string match "remotes/*" $name]} {
1663             if {![string match "*/HEAD" $name]} {
1664                 set headids($name) $id
1665                 lappend idheads($id) $name
1666             }
1667         } elseif {[string match "heads/*" $name]} {
1668             set name [string range $name 6 end]
1669             set headids($name) $id
1670             lappend idheads($id) $name
1671         } elseif {[string match "tags/*" $name]} {
1672             # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1673             # which is what we want since the former is the commit ID
1674             set name [string range $name 5 end]
1675             if {[string match "*^{}" $name]} {
1676                 set name [string range $name 0 end-3]
1677             } else {
1678                 set tagobjid($name) $id
1679             }
1680             set tagids($name) $id
1681             lappend idtags($id) $name
1682         } else {
1683             set otherrefids($name) $id
1684             lappend idotherrefs($id) $name
1685         }
1686     }
1687     catch {close $refd}
1688     set mainhead {}
1689     set mainheadid {}
1690     catch {
1691         set mainheadid [exec git rev-parse HEAD]
1692         set thehead [exec git symbolic-ref HEAD]
1693         if {[string match "refs/heads/*" $thehead]} {
1694             set mainhead [string range $thehead 11 end]
1695         }
1696     }
1697     set selectheadid {}
1698     if {$selecthead ne {}} {
1699         catch {
1700             set selectheadid [exec git rev-parse --verify $selecthead]
1701         }
1702     }
1703 }
1704
1705 # skip over fake commits
1706 proc first_real_row {} {
1707     global nullid nullid2 numcommits
1708
1709     for {set row 0} {$row < $numcommits} {incr row} {
1710         set id [commitonrow $row]
1711         if {$id ne $nullid && $id ne $nullid2} {
1712             break
1713         }
1714     }
1715     return $row
1716 }
1717
1718 # update things for a head moved to a child of its previous location
1719 proc movehead {id name} {
1720     global headids idheads
1721
1722     removehead $headids($name) $name
1723     set headids($name) $id
1724     lappend idheads($id) $name
1725 }
1726
1727 # update things when a head has been removed
1728 proc removehead {id name} {
1729     global headids idheads
1730
1731     if {$idheads($id) eq $name} {
1732         unset idheads($id)
1733     } else {
1734         set i [lsearch -exact $idheads($id) $name]
1735         if {$i >= 0} {
1736             set idheads($id) [lreplace $idheads($id) $i $i]
1737         }
1738     }
1739     unset headids($name)
1740 }
1741
1742 proc show_error {w top msg} {
1743     message $w.m -text $msg -justify center -aspect 400
1744     pack $w.m -side top -fill x -padx 20 -pady 20
1745     button $w.ok -text [mc OK] -command "destroy $top"
1746     pack $w.ok -side bottom -fill x
1747     bind $top <Visibility> "grab $top; focus $top"
1748     bind $top <Key-Return> "destroy $top"
1749     tkwait window $top
1750 }
1751
1752 proc error_popup msg {
1753     set w .error
1754     toplevel $w
1755     wm transient $w .
1756     show_error $w $w $msg
1757 }
1758
1759 proc confirm_popup msg {
1760     global confirm_ok
1761     set confirm_ok 0
1762     set w .confirm
1763     toplevel $w
1764     wm transient $w .
1765     message $w.m -text $msg -justify center -aspect 400
1766     pack $w.m -side top -fill x -padx 20 -pady 20
1767     button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
1768     pack $w.ok -side left -fill x
1769     button $w.cancel -text [mc Cancel] -command "destroy $w"
1770     pack $w.cancel -side right -fill x
1771     bind $w <Visibility> "grab $w; focus $w"
1772     tkwait window $w
1773     return $confirm_ok
1774 }
1775
1776 proc setoptions {} {
1777     option add *Panedwindow.showHandle 1 startupFile
1778     option add *Panedwindow.sashRelief raised startupFile
1779     option add *Button.font uifont startupFile
1780     option add *Checkbutton.font uifont startupFile
1781     option add *Radiobutton.font uifont startupFile
1782     option add *Menu.font uifont startupFile
1783     option add *Menubutton.font uifont startupFile
1784     option add *Label.font uifont startupFile
1785     option add *Message.font uifont startupFile
1786     option add *Entry.font uifont startupFile
1787 }
1788
1789 # Make a menu and submenus.
1790 # m is the window name for the menu, items is the list of menu items to add.
1791 # Each item is a list {mc label type description options...}
1792 # mc is ignored; it's so we can put mc there to alert xgettext
1793 # label is the string that appears in the menu
1794 # type is cascade, command or radiobutton (should add checkbutton)
1795 # description depends on type; it's the sublist for cascade, the
1796 # command to invoke for command, or {variable value} for radiobutton
1797 proc makemenu {m items} {
1798     menu $m
1799     foreach i $items {
1800         set name [mc [lindex $i 1]]
1801         set type [lindex $i 2]
1802         set thing [lindex $i 3]
1803         set params [list $type]
1804         if {$name ne {}} {
1805             set u [string first "&" [string map {&& x} $name]]
1806             lappend params -label [string map {&& & & {}} $name]
1807             if {$u >= 0} {
1808                 lappend params -underline $u
1809             }
1810         }
1811         switch -- $type {
1812             "cascade" {
1813                 set submenu [string tolower [string map {& ""} [lindex $i 1]]]
1814                 lappend params -menu $m.$submenu
1815             }
1816             "command" {
1817                 lappend params -command $thing
1818             }
1819             "radiobutton" {
1820                 lappend params -variable [lindex $thing 0] \
1821                     -value [lindex $thing 1]
1822             }
1823         }
1824         eval $m add $params [lrange $i 4 end]
1825         if {$type eq "cascade"} {
1826             makemenu $m.$submenu $thing
1827         }
1828     }
1829 }
1830
1831 # translate string and remove ampersands
1832 proc mca {str} {
1833     return [string map {&& & & {}} [mc $str]]
1834 }
1835
1836 proc makewindow {} {
1837     global canv canv2 canv3 linespc charspc ctext cflist cscroll
1838     global tabstop
1839     global findtype findtypemenu findloc findstring fstring geometry
1840     global entries sha1entry sha1string sha1but
1841     global diffcontextstring diffcontext
1842     global ignorespace
1843     global maincursor textcursor curtextcursor
1844     global rowctxmenu fakerowmenu mergemax wrapcomment
1845     global highlight_files gdttype
1846     global searchstring sstring
1847     global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
1848     global headctxmenu progresscanv progressitem progresscoords statusw
1849     global fprogitem fprogcoord lastprogupdate progupdatepending
1850     global rprogitem rprogcoord rownumsel numcommits
1851     global have_tk85
1852
1853     # The "mc" arguments here are purely so that xgettext
1854     # sees the following string as needing to be translated
1855     makemenu .bar {
1856         {mc "File" cascade {
1857             {mc "Update" command updatecommits -accelerator F5}
1858             {mc "Reload" command reloadcommits}
1859             {mc "Reread references" command rereadrefs}
1860             {mc "List references" command showrefs}
1861             {mc "Quit" command doquit}
1862         }}
1863         {mc "Edit" cascade {
1864             {mc "Preferences" command doprefs}
1865         }}
1866         {mc "View" cascade {
1867             {mc "New view..." command {newview 0}}
1868             {mc "Edit view..." command editview -state disabled}
1869             {mc "Delete view" command delview -state disabled}
1870             {xx "" separator}
1871             {mc "All files" radiobutton {selectedview 0} -command {showview 0}}
1872         }}
1873         {mc "Help" cascade {
1874             {mc "About gitk" command about}
1875             {mc "Key bindings" command keys}
1876         }}
1877     }
1878     . configure -menu .bar
1879
1880     # the gui has upper and lower half, parts of a paned window.
1881     panedwindow .ctop -orient vertical
1882
1883     # possibly use assumed geometry
1884     if {![info exists geometry(pwsash0)]} {
1885         set geometry(topheight) [expr {15 * $linespc}]
1886         set geometry(topwidth) [expr {80 * $charspc}]
1887         set geometry(botheight) [expr {15 * $linespc}]
1888         set geometry(botwidth) [expr {50 * $charspc}]
1889         set geometry(pwsash0) "[expr {40 * $charspc}] 2"
1890         set geometry(pwsash1) "[expr {60 * $charspc}] 2"
1891     }
1892
1893     # the upper half will have a paned window, a scroll bar to the right, and some stuff below
1894     frame .tf -height $geometry(topheight) -width $geometry(topwidth)
1895     frame .tf.histframe
1896     panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
1897
1898     # create three canvases
1899     set cscroll .tf.histframe.csb
1900     set canv .tf.histframe.pwclist.canv
1901     canvas $canv \
1902         -selectbackground $selectbgcolor \
1903         -background $bgcolor -bd 0 \
1904         -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
1905     .tf.histframe.pwclist add $canv
1906     set canv2 .tf.histframe.pwclist.canv2
1907     canvas $canv2 \
1908         -selectbackground $selectbgcolor \
1909         -background $bgcolor -bd 0 -yscrollincr $linespc
1910     .tf.histframe.pwclist add $canv2
1911     set canv3 .tf.histframe.pwclist.canv3
1912     canvas $canv3 \
1913         -selectbackground $selectbgcolor \
1914         -background $bgcolor -bd 0 -yscrollincr $linespc
1915     .tf.histframe.pwclist add $canv3
1916     eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
1917     eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
1918
1919     # a scroll bar to rule them
1920     scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
1921     pack $cscroll -side right -fill y
1922     bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
1923     lappend bglist $canv $canv2 $canv3
1924     pack .tf.histframe.pwclist -fill both -expand 1 -side left
1925
1926     # we have two button bars at bottom of top frame. Bar 1
1927     frame .tf.bar
1928     frame .tf.lbar -height 15
1929
1930     set sha1entry .tf.bar.sha1
1931     set entries $sha1entry
1932     set sha1but .tf.bar.sha1label
1933     button $sha1but -text [mc "SHA1 ID: "] -state disabled -relief flat \
1934         -command gotocommit -width 8
1935     $sha1but conf -disabledforeground [$sha1but cget -foreground]
1936     pack .tf.bar.sha1label -side left
1937     entry $sha1entry -width 40 -font textfont -textvariable sha1string
1938     trace add variable sha1string write sha1change
1939     pack $sha1entry -side left -pady 2
1940
1941     image create bitmap bm-left -data {
1942         #define left_width 16
1943         #define left_height 16
1944         static unsigned char left_bits[] = {
1945         0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
1946         0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
1947         0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
1948     }
1949     image create bitmap bm-right -data {
1950         #define right_width 16
1951         #define right_height 16
1952         static unsigned char right_bits[] = {
1953         0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
1954         0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
1955         0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
1956     }
1957     button .tf.bar.leftbut -image bm-left -command goback \
1958         -state disabled -width 26
1959     pack .tf.bar.leftbut -side left -fill y
1960     button .tf.bar.rightbut -image bm-right -command goforw \
1961         -state disabled -width 26
1962     pack .tf.bar.rightbut -side left -fill y
1963
1964     label .tf.bar.rowlabel -text [mc "Row"]
1965     set rownumsel {}
1966     label .tf.bar.rownum -width 7 -font textfont -textvariable rownumsel \
1967         -relief sunken -anchor e
1968     label .tf.bar.rowlabel2 -text "/"
1969     label .tf.bar.numcommits -width 7 -font textfont -textvariable numcommits \
1970         -relief sunken -anchor e
1971     pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
1972         -side left
1973     global selectedline
1974     trace add variable selectedline write selectedline_change
1975
1976     # Status label and progress bar
1977     set statusw .tf.bar.status
1978     label $statusw -width 15 -relief sunken
1979     pack $statusw -side left -padx 5
1980     set h [expr {[font metrics uifont -linespace] + 2}]
1981     set progresscanv .tf.bar.progress
1982     canvas $progresscanv -relief sunken -height $h -borderwidth 2
1983     set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
1984     set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
1985     set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
1986     pack $progresscanv -side right -expand 1 -fill x
1987     set progresscoords {0 0}
1988     set fprogcoord 0
1989     set rprogcoord 0
1990     bind $progresscanv <Configure> adjustprogress
1991     set lastprogupdate [clock clicks -milliseconds]
1992     set progupdatepending 0
1993
1994     # build up the bottom bar of upper window
1995     label .tf.lbar.flabel -text "[mc "Find"] "
1996     button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
1997     button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
1998     label .tf.lbar.flab2 -text " [mc "commit"] "
1999     pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
2000         -side left -fill y
2001     set gdttype [mc "containing:"]
2002     set gm [tk_optionMenu .tf.lbar.gdttype gdttype \
2003                 [mc "containing:"] \
2004                 [mc "touching paths:"] \
2005                 [mc "adding/removing string:"]]
2006     trace add variable gdttype write gdttype_change
2007     pack .tf.lbar.gdttype -side left -fill y
2008
2009     set findstring {}
2010     set fstring .tf.lbar.findstring
2011     lappend entries $fstring
2012     entry $fstring -width 30 -font textfont -textvariable findstring
2013     trace add variable findstring write find_change
2014     set findtype [mc "Exact"]
2015     set findtypemenu [tk_optionMenu .tf.lbar.findtype \
2016                       findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
2017     trace add variable findtype write findcom_change
2018     set findloc [mc "All fields"]
2019     tk_optionMenu .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
2020         [mc "Comments"] [mc "Author"] [mc "Committer"]
2021     trace add variable findloc write find_change
2022     pack .tf.lbar.findloc -side right
2023     pack .tf.lbar.findtype -side right
2024     pack $fstring -side left -expand 1 -fill x
2025
2026     # Finish putting the upper half of the viewer together
2027     pack .tf.lbar -in .tf -side bottom -fill x
2028     pack .tf.bar -in .tf -side bottom -fill x
2029     pack .tf.histframe -fill both -side top -expand 1
2030     .ctop add .tf
2031     .ctop paneconfigure .tf -height $geometry(topheight)
2032     .ctop paneconfigure .tf -width $geometry(topwidth)
2033
2034     # now build up the bottom
2035     panedwindow .pwbottom -orient horizontal
2036
2037     # lower left, a text box over search bar, scroll bar to the right
2038     # if we know window height, then that will set the lower text height, otherwise
2039     # we set lower text height which will drive window height
2040     if {[info exists geometry(main)]} {
2041         frame .bleft -width $geometry(botwidth)
2042     } else {
2043         frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
2044     }
2045     frame .bleft.top
2046     frame .bleft.mid
2047     frame .bleft.bottom
2048
2049     button .bleft.top.search -text [mc "Search"] -command dosearch
2050     pack .bleft.top.search -side left -padx 5
2051     set sstring .bleft.top.sstring
2052     entry $sstring -width 20 -font textfont -textvariable searchstring
2053     lappend entries $sstring
2054     trace add variable searchstring write incrsearch
2055     pack $sstring -side left -expand 1 -fill x
2056     radiobutton .bleft.mid.diff -text [mc "Diff"] \
2057         -command changediffdisp -variable diffelide -value {0 0}
2058     radiobutton .bleft.mid.old -text [mc "Old version"] \
2059         -command changediffdisp -variable diffelide -value {0 1}
2060     radiobutton .bleft.mid.new -text [mc "New version"] \
2061         -command changediffdisp -variable diffelide -value {1 0}
2062     label .bleft.mid.labeldiffcontext -text "      [mc "Lines of context"]: "
2063     pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
2064     spinbox .bleft.mid.diffcontext -width 5 -font textfont \
2065         -from 1 -increment 1 -to 10000000 \
2066         -validate all -validatecommand "diffcontextvalidate %P" \
2067         -textvariable diffcontextstring
2068     .bleft.mid.diffcontext set $diffcontext
2069     trace add variable diffcontextstring write diffcontextchange
2070     lappend entries .bleft.mid.diffcontext
2071     pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
2072     checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
2073         -command changeignorespace -variable ignorespace
2074     pack .bleft.mid.ignspace -side left -padx 5
2075     set ctext .bleft.bottom.ctext
2076     text $ctext -background $bgcolor -foreground $fgcolor \
2077         -state disabled -font textfont \
2078         -yscrollcommand scrolltext -wrap none \
2079         -xscrollcommand ".bleft.bottom.sbhorizontal set"
2080     if {$have_tk85} {
2081         $ctext conf -tabstyle wordprocessor
2082     }
2083     scrollbar .bleft.bottom.sb -command "$ctext yview"
2084     scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h \
2085         -width 10
2086     pack .bleft.top -side top -fill x
2087     pack .bleft.mid -side top -fill x
2088     grid $ctext .bleft.bottom.sb -sticky nsew
2089     grid .bleft.bottom.sbhorizontal -sticky ew
2090     grid columnconfigure .bleft.bottom 0 -weight 1
2091     grid rowconfigure .bleft.bottom 0 -weight 1
2092     grid rowconfigure .bleft.bottom 1 -weight 0
2093     pack .bleft.bottom -side top -fill both -expand 1
2094     lappend bglist $ctext
2095     lappend fglist $ctext
2096
2097     $ctext tag conf comment -wrap $wrapcomment
2098     $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
2099     $ctext tag conf hunksep -fore [lindex $diffcolors 2]
2100     $ctext tag conf d0 -fore [lindex $diffcolors 0]
2101     $ctext tag conf dresult -fore [lindex $diffcolors 1]
2102     $ctext tag conf m0 -fore red
2103     $ctext tag conf m1 -fore blue
2104     $ctext tag conf m2 -fore green
2105     $ctext tag conf m3 -fore purple
2106     $ctext tag conf m4 -fore brown
2107     $ctext tag conf m5 -fore "#009090"
2108     $ctext tag conf m6 -fore magenta
2109     $ctext tag conf m7 -fore "#808000"
2110     $ctext tag conf m8 -fore "#009000"
2111     $ctext tag conf m9 -fore "#ff0080"
2112     $ctext tag conf m10 -fore cyan
2113     $ctext tag conf m11 -fore "#b07070"
2114     $ctext tag conf m12 -fore "#70b0f0"
2115     $ctext tag conf m13 -fore "#70f0b0"
2116     $ctext tag conf m14 -fore "#f0b070"
2117     $ctext tag conf m15 -fore "#ff70b0"
2118     $ctext tag conf mmax -fore darkgrey
2119     set mergemax 16
2120     $ctext tag conf mresult -font textfontbold
2121     $ctext tag conf msep -font textfontbold
2122     $ctext tag conf found -back yellow
2123
2124     .pwbottom add .bleft
2125     .pwbottom paneconfigure .bleft -width $geometry(botwidth)
2126
2127     # lower right
2128     frame .bright
2129     frame .bright.mode
2130     radiobutton .bright.mode.patch -text [mc "Patch"] \
2131         -command reselectline -variable cmitmode -value "patch"
2132     radiobutton .bright.mode.tree -text [mc "Tree"] \
2133         -command reselectline -variable cmitmode -value "tree"
2134     grid .bright.mode.patch .bright.mode.tree -sticky ew
2135     pack .bright.mode -side top -fill x
2136     set cflist .bright.cfiles
2137     set indent [font measure mainfont "nn"]
2138     text $cflist \
2139         -selectbackground $selectbgcolor \
2140         -background $bgcolor -foreground $fgcolor \
2141         -font mainfont \
2142         -tabs [list $indent [expr {2 * $indent}]] \
2143         -yscrollcommand ".bright.sb set" \
2144         -cursor [. cget -cursor] \
2145         -spacing1 1 -spacing3 1
2146     lappend bglist $cflist
2147     lappend fglist $cflist
2148     scrollbar .bright.sb -command "$cflist yview"
2149     pack .bright.sb -side right -fill y
2150     pack $cflist -side left -fill both -expand 1
2151     $cflist tag configure highlight \
2152         -background [$cflist cget -selectbackground]
2153     $cflist tag configure bold -font mainfontbold
2154
2155     .pwbottom add .bright
2156     .ctop add .pwbottom
2157
2158     # restore window width & height if known
2159     if {[info exists geometry(main)]} {
2160         if {[scan $geometry(main) "%dx%d" w h] >= 2} {
2161             if {$w > [winfo screenwidth .]} {
2162                 set w [winfo screenwidth .]
2163             }
2164             if {$h > [winfo screenheight .]} {
2165                 set h [winfo screenheight .]
2166             }
2167             wm geometry . "${w}x$h"
2168         }
2169     }
2170
2171     if {[tk windowingsystem] eq {aqua}} {
2172         set M1B M1
2173     } else {
2174         set M1B Control
2175     }
2176
2177     bind .pwbottom <Configure> {resizecdetpanes %W %w}
2178     pack .ctop -fill both -expand 1
2179     bindall <1> {selcanvline %W %x %y}
2180     #bindall <B1-Motion> {selcanvline %W %x %y}
2181     if {[tk windowingsystem] == "win32"} {
2182         bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
2183         bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
2184     } else {
2185         bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
2186         bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
2187         if {[tk windowingsystem] eq "aqua"} {
2188             bindall <MouseWheel> {
2189                 set delta [expr {- (%D)}]
2190                 allcanvs yview scroll $delta units
2191             }
2192         }
2193     }
2194     bindall <2> "canvscan mark %W %x %y"
2195     bindall <B2-Motion> "canvscan dragto %W %x %y"
2196     bindkey <Home> selfirstline
2197     bindkey <End> sellastline
2198     bind . <Key-Up> "selnextline -1"
2199     bind . <Key-Down> "selnextline 1"
2200     bind . <Shift-Key-Up> "dofind -1 0"
2201     bind . <Shift-Key-Down> "dofind 1 0"
2202     bindkey <Key-Right> "goforw"
2203     bindkey <Key-Left> "goback"
2204     bind . <Key-Prior> "selnextpage -1"
2205     bind . <Key-Next> "selnextpage 1"
2206     bind . <$M1B-Home> "allcanvs yview moveto 0.0"
2207     bind . <$M1B-End> "allcanvs yview moveto 1.0"
2208     bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
2209     bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
2210     bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2211     bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
2212     bindkey <Key-Delete> "$ctext yview scroll -1 pages"
2213     bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
2214     bindkey <Key-space> "$ctext yview scroll 1 pages"
2215     bindkey p "selnextline -1"
2216     bindkey n "selnextline 1"
2217     bindkey z "goback"
2218     bindkey x "goforw"
2219     bindkey i "selnextline -1"
2220     bindkey k "selnextline 1"
2221     bindkey j "goback"
2222     bindkey l "goforw"
2223     bindkey b prevfile
2224     bindkey d "$ctext yview scroll 18 units"
2225     bindkey u "$ctext yview scroll -18 units"
2226     bindkey / {dofind 1 1}
2227     bindkey <Key-Return> {dofind 1 1}
2228     bindkey ? {dofind -1 1}
2229     bindkey f nextfile
2230     bindkey <F5> updatecommits
2231     bind . <$M1B-q> doquit
2232     bind . <$M1B-f> {dofind 1 1}
2233     bind . <$M1B-g> {dofind 1 0}
2234     bind . <$M1B-r> dosearchback
2235     bind . <$M1B-s> dosearch
2236     bind . <$M1B-equal> {incrfont 1}
2237     bind . <$M1B-plus> {incrfont 1}
2238     bind . <$M1B-KP_Add> {incrfont 1}
2239     bind . <$M1B-minus> {incrfont -1}
2240     bind . <$M1B-KP_Subtract> {incrfont -1}
2241     wm protocol . WM_DELETE_WINDOW doquit
2242     bind . <Destroy> {stop_backends}
2243     bind . <Button-1> "click %W"
2244     bind $fstring <Key-Return> {dofind 1 1}
2245     bind $sha1entry <Key-Return> {gotocommit; break}
2246     bind $sha1entry <<PasteSelection>> clearsha1
2247     bind $cflist <1> {sel_flist %W %x %y; break}
2248     bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
2249     bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
2250     global ctxbut
2251     bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
2252     bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
2253
2254     set maincursor [. cget -cursor]
2255     set textcursor [$ctext cget -cursor]
2256     set curtextcursor $textcursor
2257
2258     set rowctxmenu .rowctxmenu
2259     makemenu $rowctxmenu {
2260         {mc "Diff this -> selected" command {diffvssel 0}}
2261         {mc "Diff selected -> this" command {diffvssel 1}}
2262         {mc "Make patch" command mkpatch}
2263         {mc "Create tag" command mktag}
2264         {mc "Write commit to file" command writecommit}
2265         {mc "Create new branch" command mkbranch}
2266         {mc "Cherry-pick this commit" command cherrypick}
2267         {mc "Reset HEAD branch to here" command resethead}
2268     }
2269     $rowctxmenu configure -tearoff 0
2270
2271     set fakerowmenu .fakerowmenu
2272     makemenu $fakerowmenu {
2273         {mc "Diff this -> selected" command {diffvssel 0}}
2274         {mc "Diff selected -> this" command {diffvssel 1}}
2275         {mc "Make patch" command mkpatch}
2276     }
2277     $fakerowmenu configure -tearoff 0
2278
2279     set headctxmenu .headctxmenu
2280     makemenu $headctxmenu {
2281         {mc "Check out this branch" command cobranch}
2282         {mc "Remove this branch" command rmbranch}
2283     }
2284     $headctxmenu configure -tearoff 0
2285
2286     global flist_menu
2287     set flist_menu .flistctxmenu
2288     makemenu $flist_menu {
2289         {mc "Highlight this too" command {flist_hl 0}}
2290         {mc "Highlight this only" command {flist_hl 1}}
2291         {mc "External diff" command {external_diff}}
2292         {mc "Blame parent commit" command {external_blame 1}}
2293     }
2294     $flist_menu configure -tearoff 0
2295
2296     global diff_menu
2297     set diff_menu .diffctxmenu
2298     makemenu $diff_menu {
2299         {mc "Show origin of this line" command show_line_source}
2300         {mc "Run git gui blame on this line" command {external_blame_diff}}
2301     }
2302     $diff_menu configure -tearoff 0
2303 }
2304
2305 # Windows sends all mouse wheel events to the current focused window, not
2306 # the one where the mouse hovers, so bind those events here and redirect
2307 # to the correct window
2308 proc windows_mousewheel_redirector {W X Y D} {
2309     global canv canv2 canv3
2310     set w [winfo containing -displayof $W $X $Y]
2311     if {$w ne ""} {
2312         set u [expr {$D < 0 ? 5 : -5}]
2313         if {$w == $canv || $w == $canv2 || $w == $canv3} {
2314             allcanvs yview scroll $u units
2315         } else {
2316             catch {
2317                 $w yview scroll $u units
2318             }
2319         }
2320     }
2321 }
2322
2323 # Update row number label when selectedline changes
2324 proc selectedline_change {n1 n2 op} {
2325     global selectedline rownumsel
2326
2327     if {$selectedline eq {}} {
2328         set rownumsel {}
2329     } else {
2330         set rownumsel [expr {$selectedline + 1}]
2331     }
2332 }
2333
2334 # mouse-2 makes all windows scan vertically, but only the one
2335 # the cursor is in scans horizontally
2336 proc canvscan {op w x y} {
2337     global canv canv2 canv3
2338     foreach c [list $canv $canv2 $canv3] {
2339         if {$c == $w} {
2340             $c scan $op $x $y
2341         } else {
2342             $c scan $op 0 $y
2343         }
2344     }
2345 }
2346
2347 proc scrollcanv {cscroll f0 f1} {
2348     $cscroll set $f0 $f1
2349     drawvisible
2350     flushhighlights
2351 }
2352
2353 # when we make a key binding for the toplevel, make sure
2354 # it doesn't get triggered when that key is pressed in the
2355 # find string entry widget.
2356 proc bindkey {ev script} {
2357     global entries
2358     bind . $ev $script
2359     set escript [bind Entry $ev]
2360     if {$escript == {}} {
2361         set escript [bind Entry <Key>]
2362     }
2363     foreach e $entries {
2364         bind $e $ev "$escript; break"
2365     }
2366 }
2367
2368 # set the focus back to the toplevel for any click outside
2369 # the entry widgets
2370 proc click {w} {
2371     global ctext entries
2372     foreach e [concat $entries $ctext] {
2373         if {$w == $e} return
2374     }
2375     focus .
2376 }
2377
2378 # Adjust the progress bar for a change in requested extent or canvas size
2379 proc adjustprogress {} {
2380     global progresscanv progressitem progresscoords
2381     global fprogitem fprogcoord lastprogupdate progupdatepending
2382     global rprogitem rprogcoord
2383
2384     set w [expr {[winfo width $progresscanv] - 4}]
2385     set x0 [expr {$w * [lindex $progresscoords 0]}]
2386     set x1 [expr {$w * [lindex $progresscoords 1]}]
2387     set h [winfo height $progresscanv]
2388     $progresscanv coords $progressitem $x0 0 $x1 $h
2389     $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2390     $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2391     set now [clock clicks -milliseconds]
2392     if {$now >= $lastprogupdate + 100} {
2393         set progupdatepending 0
2394         update
2395     } elseif {!$progupdatepending} {
2396         set progupdatepending 1
2397         after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2398     }
2399 }
2400
2401 proc doprogupdate {} {
2402     global lastprogupdate progupdatepending
2403
2404     if {$progupdatepending} {
2405         set progupdatepending 0
2406         set lastprogupdate [clock clicks -milliseconds]
2407         update
2408     }
2409 }
2410
2411 proc savestuff {w} {
2412     global canv canv2 canv3 mainfont textfont uifont tabstop
2413     global stuffsaved findmergefiles maxgraphpct
2414     global maxwidth showneartags showlocalchanges
2415     global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
2416     global cmitmode wrapcomment datetimeformat limitdiffs
2417     global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
2418     global autoselect extdifftool perfile_attrs markbgcolor
2419
2420     if {$stuffsaved} return
2421     if {![winfo viewable .]} return
2422     catch {
2423         set f [open "~/.gitk-new" w]
2424         puts $f [list set mainfont $mainfont]
2425         puts $f [list set textfont $textfont]
2426         puts $f [list set uifont $uifont]
2427         puts $f [list set tabstop $tabstop]
2428         puts $f [list set findmergefiles $findmergefiles]
2429         puts $f [list set maxgraphpct $maxgraphpct]
2430         puts $f [list set maxwidth $maxwidth]
2431         puts $f [list set cmitmode $cmitmode]
2432         puts $f [list set wrapcomment $wrapcomment]
2433         puts $f [list set autoselect $autoselect]
2434         puts $f [list set showneartags $showneartags]
2435         puts $f [list set showlocalchanges $showlocalchanges]
2436         puts $f [list set datetimeformat $datetimeformat]
2437         puts $f [list set limitdiffs $limitdiffs]
2438         puts $f [list set bgcolor $bgcolor]
2439         puts $f [list set fgcolor $fgcolor]
2440         puts $f [list set colors $colors]
2441         puts $f [list set diffcolors $diffcolors]
2442         puts $f [list set markbgcolor $markbgcolor]
2443         puts $f [list set diffcontext $diffcontext]
2444         puts $f [list set selectbgcolor $selectbgcolor]
2445         puts $f [list set extdifftool $extdifftool]
2446         puts $f [list set perfile_attrs $perfile_attrs]
2447
2448         puts $f "set geometry(main) [wm geometry .]"
2449         puts $f "set geometry(topwidth) [winfo width .tf]"
2450         puts $f "set geometry(topheight) [winfo height .tf]"
2451         puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2452         puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2453         puts $f "set geometry(botwidth) [winfo width .bleft]"
2454         puts $f "set geometry(botheight) [winfo height .bleft]"
2455
2456         puts -nonewline $f "set permviews {"
2457         for {set v 0} {$v < $nextviewnum} {incr v} {
2458             if {$viewperm($v)} {
2459                 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
2460             }
2461         }
2462         puts $f "}"
2463         close $f
2464         file rename -force "~/.gitk-new" "~/.gitk"
2465     }
2466     set stuffsaved 1
2467 }
2468
2469 proc resizeclistpanes {win w} {
2470     global oldwidth
2471     if {[info exists oldwidth($win)]} {
2472         set s0 [$win sash coord 0]
2473         set s1 [$win sash coord 1]
2474         if {$w < 60} {
2475             set sash0 [expr {int($w/2 - 2)}]
2476             set sash1 [expr {int($w*5/6 - 2)}]
2477         } else {
2478             set factor [expr {1.0 * $w / $oldwidth($win)}]
2479             set sash0 [expr {int($factor * [lindex $s0 0])}]
2480             set sash1 [expr {int($factor * [lindex $s1 0])}]
2481             if {$sash0 < 30} {
2482                 set sash0 30
2483             }
2484             if {$sash1 < $sash0 + 20} {
2485                 set sash1 [expr {$sash0 + 20}]
2486             }
2487             if {$sash1 > $w - 10} {
2488                 set sash1 [expr {$w - 10}]
2489                 if {$sash0 > $sash1 - 20} {
2490                     set sash0 [expr {$sash1 - 20}]
2491                 }
2492             }
2493         }
2494         $win sash place 0 $sash0 [lindex $s0 1]
2495         $win sash place 1 $sash1 [lindex $s1 1]
2496     }
2497     set oldwidth($win) $w
2498 }
2499
2500 proc resizecdetpanes {win w} {
2501     global oldwidth
2502     if {[info exists oldwidth($win)]} {
2503         set s0 [$win sash coord 0]
2504         if {$w < 60} {
2505             set sash0 [expr {int($w*3/4 - 2)}]
2506         } else {
2507             set factor [expr {1.0 * $w / $oldwidth($win)}]
2508             set sash0 [expr {int($factor * [lindex $s0 0])}]
2509             if {$sash0 < 45} {
2510                 set sash0 45
2511             }
2512             if {$sash0 > $w - 15} {
2513                 set sash0 [expr {$w - 15}]
2514             }
2515         }
2516         $win sash place 0 $sash0 [lindex $s0 1]
2517     }
2518     set oldwidth($win) $w
2519 }
2520
2521 proc allcanvs args {
2522     global canv canv2 canv3
2523     eval $canv $args
2524     eval $canv2 $args
2525     eval $canv3 $args
2526 }
2527
2528 proc bindall {event action} {
2529     global canv canv2 canv3
2530     bind $canv $event $action
2531     bind $canv2 $event $action
2532     bind $canv3 $event $action
2533 }
2534
2535 proc about {} {
2536     global uifont
2537     set w .about
2538     if {[winfo exists $w]} {
2539         raise $w
2540         return
2541     }
2542     toplevel $w
2543     wm title $w [mc "About gitk"]
2544     message $w.m -text [mc "
2545 Gitk - a commit viewer for git
2546
2547 Copyright © 2005-2008 Paul Mackerras
2548
2549 Use and redistribute under the terms of the GNU General Public License"] \
2550             -justify center -aspect 400 -border 2 -bg white -relief groove
2551     pack $w.m -side top -fill x -padx 2 -pady 2
2552     button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2553     pack $w.ok -side bottom
2554     bind $w <Visibility> "focus $w.ok"
2555     bind $w <Key-Escape> "destroy $w"
2556     bind $w <Key-Return> "destroy $w"
2557 }
2558
2559 proc keys {} {
2560     set w .keys
2561     if {[winfo exists $w]} {
2562         raise $w
2563         return
2564     }
2565     if {[tk windowingsystem] eq {aqua}} {
2566         set M1T Cmd
2567     } else {
2568         set M1T Ctrl
2569     }
2570     toplevel $w
2571     wm title $w [mc "Gitk key bindings"]
2572     message $w.m -text "
2573 [mc "Gitk key bindings:"]
2574
2575 [mc "<%s-Q>             Quit" $M1T]
2576 [mc "<Home>             Move to first commit"]
2577 [mc "<End>              Move to last commit"]
2578 [mc "<Up>, p, i Move up one commit"]
2579 [mc "<Down>, n, k       Move down one commit"]
2580 [mc "<Left>, z, j       Go back in history list"]
2581 [mc "<Right>, x, l      Go forward in history list"]
2582 [mc "<PageUp>   Move up one page in commit list"]
2583 [mc "<PageDown> Move down one page in commit list"]
2584 [mc "<%s-Home>  Scroll to top of commit list" $M1T]
2585 [mc "<%s-End>   Scroll to bottom of commit list" $M1T]
2586 [mc "<%s-Up>    Scroll commit list up one line" $M1T]
2587 [mc "<%s-Down>  Scroll commit list down one line" $M1T]
2588 [mc "<%s-PageUp>        Scroll commit list up one page" $M1T]
2589 [mc "<%s-PageDown>      Scroll commit list down one page" $M1T]
2590 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
2591 [mc "<Shift-Down>       Find forwards (downwards, earlier commits)"]
2592 [mc "<Delete>, b        Scroll diff view up one page"]
2593 [mc "<Backspace>        Scroll diff view up one page"]
2594 [mc "<Space>            Scroll diff view down one page"]
2595 [mc "u          Scroll diff view up 18 lines"]
2596 [mc "d          Scroll diff view down 18 lines"]
2597 [mc "<%s-F>             Find" $M1T]
2598 [mc "<%s-G>             Move to next find hit" $M1T]
2599 [mc "<Return>   Move to next find hit"]
2600 [mc "/          Move to next find hit, or redo find"]
2601 [mc "?          Move to previous find hit"]
2602 [mc "f          Scroll diff view to next file"]
2603 [mc "<%s-S>             Search for next hit in diff view" $M1T]
2604 [mc "<%s-R>             Search for previous hit in diff view" $M1T]
2605 [mc "<%s-KP+>   Increase font size" $M1T]
2606 [mc "<%s-plus>  Increase font size" $M1T]
2607 [mc "<%s-KP->   Decrease font size" $M1T]
2608 [mc "<%s-minus> Decrease font size" $M1T]
2609 [mc "<F5>               Update"]
2610 " \
2611             -justify left -bg white -border 2 -relief groove
2612     pack $w.m -side top -fill both -padx 2 -pady 2
2613     button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2614     pack $w.ok -side bottom
2615     bind $w <Visibility> "focus $w.ok"
2616     bind $w <Key-Escape> "destroy $w"
2617     bind $w <Key-Return> "destroy $w"
2618 }
2619
2620 # Procedures for manipulating the file list window at the
2621 # bottom right of the overall window.
2622
2623 proc treeview {w l openlevs} {
2624     global treecontents treediropen treeheight treeparent treeindex
2625
2626     set ix 0
2627     set treeindex() 0
2628     set lev 0
2629     set prefix {}
2630     set prefixend -1
2631     set prefendstack {}
2632     set htstack {}
2633     set ht 0
2634     set treecontents() {}
2635     $w conf -state normal
2636     foreach f $l {
2637         while {[string range $f 0 $prefixend] ne $prefix} {
2638             if {$lev <= $openlevs} {
2639                 $w mark set e:$treeindex($prefix) "end -1c"
2640                 $w mark gravity e:$treeindex($prefix) left
2641             }
2642             set treeheight($prefix) $ht
2643             incr ht [lindex $htstack end]
2644             set htstack [lreplace $htstack end end]
2645             set prefixend [lindex $prefendstack end]
2646             set prefendstack [lreplace $prefendstack end end]
2647             set prefix [string range $prefix 0 $prefixend]
2648             incr lev -1
2649         }
2650         set tail [string range $f [expr {$prefixend+1}] end]
2651         while {[set slash [string first "/" $tail]] >= 0} {
2652             lappend htstack $ht
2653             set ht 0
2654             lappend prefendstack $prefixend
2655             incr prefixend [expr {$slash + 1}]
2656             set d [string range $tail 0 $slash]
2657             lappend treecontents($prefix) $d
2658             set oldprefix $prefix
2659             append prefix $d
2660             set treecontents($prefix) {}
2661             set treeindex($prefix) [incr ix]
2662             set treeparent($prefix) $oldprefix
2663             set tail [string range $tail [expr {$slash+1}] end]
2664             if {$lev <= $openlevs} {
2665                 set ht 1
2666                 set treediropen($prefix) [expr {$lev < $openlevs}]
2667                 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
2668                 $w mark set d:$ix "end -1c"
2669                 $w mark gravity d:$ix left
2670                 set str "\n"
2671                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2672                 $w insert end $str
2673                 $w image create end -align center -image $bm -padx 1 \
2674                     -name a:$ix
2675                 $w insert end $d [highlight_tag $prefix]
2676                 $w mark set s:$ix "end -1c"
2677                 $w mark gravity s:$ix left
2678             }
2679             incr lev
2680         }
2681         if {$tail ne {}} {
2682             if {$lev <= $openlevs} {
2683                 incr ht
2684                 set str "\n"
2685                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2686                 $w insert end $str
2687                 $w insert end $tail [highlight_tag $f]
2688             }
2689             lappend treecontents($prefix) $tail
2690         }
2691     }
2692     while {$htstack ne {}} {
2693         set treeheight($prefix) $ht
2694         incr ht [lindex $htstack end]
2695         set htstack [lreplace $htstack end end]
2696         set prefixend [lindex $prefendstack end]
2697         set prefendstack [lreplace $prefendstack end end]
2698         set prefix [string range $prefix 0 $prefixend]
2699     }
2700     $w conf -state disabled
2701 }
2702
2703 proc linetoelt {l} {
2704     global treeheight treecontents
2705
2706     set y 2
2707     set prefix {}
2708     while {1} {
2709         foreach e $treecontents($prefix) {
2710             if {$y == $l} {
2711                 return "$prefix$e"
2712             }
2713             set n 1
2714             if {[string index $e end] eq "/"} {
2715                 set n $treeheight($prefix$e)
2716                 if {$y + $n > $l} {
2717                     append prefix $e
2718                     incr y
2719                     break
2720                 }
2721             }
2722             incr y $n
2723         }
2724     }
2725 }
2726
2727 proc highlight_tree {y prefix} {
2728     global treeheight treecontents cflist
2729
2730     foreach e $treecontents($prefix) {
2731         set path $prefix$e
2732         if {[highlight_tag $path] ne {}} {
2733             $cflist tag add bold $y.0 "$y.0 lineend"
2734         }
2735         incr y
2736         if {[string index $e end] eq "/" && $treeheight($path) > 1} {
2737             set y [highlight_tree $y $path]
2738         }
2739     }
2740     return $y
2741 }
2742
2743 proc treeclosedir {w dir} {
2744     global treediropen treeheight treeparent treeindex
2745
2746     set ix $treeindex($dir)
2747     $w conf -state normal
2748     $w delete s:$ix e:$ix
2749     set treediropen($dir) 0
2750     $w image configure a:$ix -image tri-rt
2751     $w conf -state disabled
2752     set n [expr {1 - $treeheight($dir)}]
2753     while {$dir ne {}} {
2754         incr treeheight($dir) $n
2755         set dir $treeparent($dir)
2756     }
2757 }
2758
2759 proc treeopendir {w dir} {
2760     global treediropen treeheight treeparent treecontents treeindex
2761
2762     set ix $treeindex($dir)
2763     $w conf -state normal
2764     $w image configure a:$ix -image tri-dn
2765     $w mark set e:$ix s:$ix
2766     $w mark gravity e:$ix right
2767     set lev 0
2768     set str "\n"
2769     set n [llength $treecontents($dir)]
2770     for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
2771         incr lev
2772         append str "\t"
2773         incr treeheight($x) $n
2774     }
2775     foreach e $treecontents($dir) {
2776         set de $dir$e
2777         if {[string index $e end] eq "/"} {
2778             set iy $treeindex($de)
2779             $w mark set d:$iy e:$ix
2780             $w mark gravity d:$iy left
2781             $w insert e:$ix $str
2782             set treediropen($de) 0
2783             $w image create e:$ix -align center -image tri-rt -padx 1 \
2784                 -name a:$iy
2785             $w insert e:$ix $e [highlight_tag $de]
2786             $w mark set s:$iy e:$ix
2787             $w mark gravity s:$iy left
2788             set treeheight($de) 1
2789         } else {
2790             $w insert e:$ix $str
2791             $w insert e:$ix $e [highlight_tag $de]
2792         }
2793     }
2794     $w mark gravity e:$ix right
2795     $w conf -state disabled
2796     set treediropen($dir) 1
2797     set top [lindex [split [$w index @0,0] .] 0]
2798     set ht [$w cget -height]
2799     set l [lindex [split [$w index s:$ix] .] 0]
2800     if {$l < $top} {
2801         $w yview $l.0
2802     } elseif {$l + $n + 1 > $top + $ht} {
2803         set top [expr {$l + $n + 2 - $ht}]
2804         if {$l < $top} {
2805             set top $l
2806         }
2807         $w yview $top.0
2808     }
2809 }
2810
2811 proc treeclick {w x y} {
2812     global treediropen cmitmode ctext cflist cflist_top
2813
2814     if {$cmitmode ne "tree"} return
2815     if {![info exists cflist_top]} return
2816     set l [lindex [split [$w index "@$x,$y"] "."] 0]
2817     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2818     $cflist tag add highlight $l.0 "$l.0 lineend"
2819     set cflist_top $l
2820     if {$l == 1} {
2821         $ctext yview 1.0
2822         return
2823     }
2824     set e [linetoelt $l]
2825     if {[string index $e end] ne "/"} {
2826         showfile $e
2827     } elseif {$treediropen($e)} {
2828         treeclosedir $w $e
2829     } else {
2830         treeopendir $w $e
2831     }
2832 }
2833
2834 proc setfilelist {id} {
2835     global treefilelist cflist jump_to_here
2836
2837     treeview $cflist $treefilelist($id) 0
2838     if {$jump_to_here ne {}} {
2839         set f [lindex $jump_to_here 0]
2840         if {[lsearch -exact $treefilelist($id) $f] >= 0} {
2841             showfile $f
2842         }
2843     }
2844 }
2845
2846 image create bitmap tri-rt -background black -foreground blue -data {
2847     #define tri-rt_width 13
2848     #define tri-rt_height 13
2849     static unsigned char tri-rt_bits[] = {
2850        0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
2851        0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
2852        0x00, 0x00};
2853 } -maskdata {
2854     #define tri-rt-mask_width 13
2855     #define tri-rt-mask_height 13
2856     static unsigned char tri-rt-mask_bits[] = {
2857        0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
2858        0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
2859        0x08, 0x00};
2860 }
2861 image create bitmap tri-dn -background black -foreground blue -data {
2862     #define tri-dn_width 13
2863     #define tri-dn_height 13
2864     static unsigned char tri-dn_bits[] = {
2865        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
2866        0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2867        0x00, 0x00};
2868 } -maskdata {
2869     #define tri-dn-mask_width 13
2870     #define tri-dn-mask_height 13
2871     static unsigned char tri-dn-mask_bits[] = {
2872        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
2873        0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
2874        0x00, 0x00};
2875 }
2876
2877 image create bitmap reficon-T -background black -foreground yellow -data {
2878     #define tagicon_width 13
2879     #define tagicon_height 9
2880     static unsigned char tagicon_bits[] = {
2881        0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
2882        0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
2883 } -maskdata {
2884     #define tagicon-mask_width 13
2885     #define tagicon-mask_height 9
2886     static unsigned char tagicon-mask_bits[] = {
2887        0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
2888        0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
2889 }
2890 set rectdata {
2891     #define headicon_width 13
2892     #define headicon_height 9
2893     static unsigned char headicon_bits[] = {
2894        0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
2895        0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
2896 }
2897 set rectmask {
2898     #define headicon-mask_width 13
2899     #define headicon-mask_height 9
2900     static unsigned char headicon-mask_bits[] = {
2901        0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
2902        0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
2903 }
2904 image create bitmap reficon-H -background black -foreground green \
2905     -data $rectdata -maskdata $rectmask
2906 image create bitmap reficon-o -background black -foreground "#ddddff" \
2907     -data $rectdata -maskdata $rectmask
2908
2909 proc init_flist {first} {
2910     global cflist cflist_top difffilestart
2911
2912     $cflist conf -state normal
2913     $cflist delete 0.0 end
2914     if {$first ne {}} {
2915         $cflist insert end $first
2916         set cflist_top 1
2917         $cflist tag add highlight 1.0 "1.0 lineend"
2918     } else {
2919         catch {unset cflist_top}
2920     }
2921     $cflist conf -state disabled
2922     set difffilestart {}
2923 }
2924
2925 proc highlight_tag {f} {
2926     global highlight_paths
2927
2928     foreach p $highlight_paths {
2929         if {[string match $p $f]} {
2930             return "bold"
2931         }
2932     }
2933     return {}
2934 }
2935
2936 proc highlight_filelist {} {
2937     global cmitmode cflist
2938
2939     $cflist conf -state normal
2940     if {$cmitmode ne "tree"} {
2941         set end [lindex [split [$cflist index end] .] 0]
2942         for {set l 2} {$l < $end} {incr l} {
2943             set line [$cflist get $l.0 "$l.0 lineend"]
2944             if {[highlight_tag $line] ne {}} {
2945                 $cflist tag add bold $l.0 "$l.0 lineend"
2946             }
2947         }
2948     } else {
2949         highlight_tree 2 {}
2950     }
2951     $cflist conf -state disabled
2952 }
2953
2954 proc unhighlight_filelist {} {
2955     global cflist
2956
2957     $cflist conf -state normal
2958     $cflist tag remove bold 1.0 end
2959     $cflist conf -state disabled
2960 }
2961
2962 proc add_flist {fl} {
2963     global cflist
2964
2965     $cflist conf -state normal
2966     foreach f $fl {
2967         $cflist insert end "\n"
2968         $cflist insert end $f [highlight_tag $f]
2969     }
2970     $cflist conf -state disabled
2971 }
2972
2973 proc sel_flist {w x y} {
2974     global ctext difffilestart cflist cflist_top cmitmode
2975
2976     if {$cmitmode eq "tree"} return
2977     if {![info exists cflist_top]} return
2978     set l [lindex [split [$w index "@$x,$y"] "."] 0]
2979     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2980     $cflist tag add highlight $l.0 "$l.0 lineend"
2981     set cflist_top $l
2982     if {$l == 1} {
2983         $ctext yview 1.0
2984     } else {
2985         catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
2986     }
2987 }
2988
2989 proc pop_flist_menu {w X Y x y} {
2990     global ctext cflist cmitmode flist_menu flist_menu_file
2991     global treediffs diffids
2992
2993     stopfinding
2994     set l [lindex [split [$w index "@$x,$y"] "."] 0]
2995     if {$l <= 1} return
2996     if {$cmitmode eq "tree"} {
2997         set e [linetoelt $l]
2998         if {[string index $e end] eq "/"} return
2999     } else {
3000         set e [lindex $treediffs($diffids) [expr {$l-2}]]
3001     }
3002     set flist_menu_file $e
3003     set xdiffstate "normal"
3004     if {$cmitmode eq "tree"} {
3005         set xdiffstate "disabled"
3006     }
3007     # Disable "External diff" item in tree mode
3008     $flist_menu entryconf 2 -state $xdiffstate
3009     tk_popup $flist_menu $X $Y
3010 }
3011
3012 proc find_ctext_fileinfo {line} {
3013     global ctext_file_names ctext_file_lines
3014
3015     set ok [bsearch $ctext_file_lines $line]
3016     set tline [lindex $ctext_file_lines $ok]
3017
3018     if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3019         return {}
3020     } else {
3021         return [list [lindex $ctext_file_names $ok] $tline]
3022     }
3023 }
3024
3025 proc pop_diff_menu {w X Y x y} {
3026     global ctext diff_menu flist_menu_file
3027     global diff_menu_txtpos diff_menu_line
3028     global diff_menu_filebase
3029
3030     set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3031     set diff_menu_line [lindex $diff_menu_txtpos 0]
3032     # don't pop up the menu on hunk-separator or file-separator lines
3033     if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3034         return
3035     }
3036     stopfinding
3037     set f [find_ctext_fileinfo $diff_menu_line]
3038     if {$f eq {}} return
3039     set flist_menu_file [lindex $f 0]
3040     set diff_menu_filebase [lindex $f 1]
3041     tk_popup $diff_menu $X $Y
3042 }
3043
3044 proc flist_hl {only} {
3045     global flist_menu_file findstring gdttype
3046
3047     set x [shellquote $flist_menu_file]
3048     if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
3049         set findstring $x
3050     } else {
3051         append findstring " " $x
3052     }
3053     set gdttype [mc "touching paths:"]
3054 }
3055
3056 proc save_file_from_commit {filename output what} {
3057     global nullfile
3058
3059     if {[catch {exec git show $filename -- > $output} err]} {
3060         if {[string match "fatal: bad revision *" $err]} {
3061             return $nullfile
3062         }
3063         error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
3064         return {}
3065     }
3066     return $output
3067 }
3068
3069 proc external_diff_get_one_file {diffid filename diffdir} {
3070     global nullid nullid2 nullfile
3071     global gitdir
3072
3073     if {$diffid == $nullid} {
3074         set difffile [file join [file dirname $gitdir] $filename]
3075         if {[file exists $difffile]} {
3076             return $difffile
3077         }
3078         return $nullfile
3079     }
3080     if {$diffid == $nullid2} {
3081         set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3082         return [save_file_from_commit :$filename $difffile index]
3083     }
3084     set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3085     return [save_file_from_commit $diffid:$filename $difffile \
3086                "revision $diffid"]
3087 }
3088
3089 proc external_diff {} {
3090     global gitktmpdir nullid nullid2
3091     global flist_menu_file
3092     global diffids
3093     global diffnum
3094     global gitdir extdifftool
3095
3096     if {[llength $diffids] == 1} {
3097         # no reference commit given
3098         set diffidto [lindex $diffids 0]
3099         if {$diffidto eq $nullid} {
3100             # diffing working copy with index
3101             set diffidfrom $nullid2
3102         } elseif {$diffidto eq $nullid2} {
3103             # diffing index with HEAD
3104             set diffidfrom "HEAD"
3105         } else {
3106             # use first parent commit
3107             global parentlist selectedline
3108             set diffidfrom [lindex $parentlist $selectedline 0]
3109         }
3110     } else {
3111         set diffidfrom [lindex $diffids 0]
3112         set diffidto [lindex $diffids 1]
3113     }
3114
3115     # make sure that several diffs wont collide
3116     if {![info exists gitktmpdir]} {
3117         set gitktmpdir [file join [file dirname $gitdir] \
3118                             [format ".gitk-tmp.%s" [pid]]]
3119         if {[catch {file mkdir $gitktmpdir} err]} {
3120             error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3121             unset gitktmpdir
3122             return
3123         }
3124         set diffnum 0
3125     }
3126     incr diffnum
3127     set diffdir [file join $gitktmpdir $diffnum]
3128     if {[catch {file mkdir $diffdir} err]} {
3129         error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3130         return
3131     }
3132
3133     # gather files to diff
3134     set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3135     set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3136
3137     if {$difffromfile ne {} && $difftofile ne {}} {
3138         set cmd [concat | [shellsplit $extdifftool] \
3139                      [list $difffromfile $difftofile]]
3140         if {[catch {set fl [open $cmd r]} err]} {
3141             file delete -force $diffdir
3142             error_popup "$extdifftool: [mc "command failed:"] $err"
3143         } else {
3144             fconfigure $fl -blocking 0
3145             filerun $fl [list delete_at_eof $fl $diffdir]
3146         }
3147     }
3148 }
3149
3150 proc find_hunk_blamespec {base line} {
3151     global ctext
3152
3153     # Find and parse the hunk header
3154     set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3155     if {$s_lix eq {}} return
3156
3157     set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3158     if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3159             s_line old_specs osz osz1 new_line nsz]} {
3160         return
3161     }
3162
3163     # base lines for the parents
3164     set base_lines [list $new_line]
3165     foreach old_spec [lrange [split $old_specs " "] 1 end] {
3166         if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3167                 old_spec old_line osz]} {
3168             return
3169         }
3170         lappend base_lines $old_line
3171     }
3172
3173     # Now scan the lines to determine offset within the hunk
3174     set max_parent [expr {[llength $base_lines]-2}]
3175     set dline 0
3176     set s_lno [lindex [split $s_lix "."] 0]
3177
3178     # Determine if the line is removed
3179     set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3180     if {[string match {[-+ ]*} $chunk]} {
3181         set removed_idx [string first "-" $chunk]
3182         # Choose a parent index
3183         if {$removed_idx >= 0} {
3184             set parent $removed_idx
3185         } else {
3186             set unchanged_idx [string first " " $chunk]
3187             if {$unchanged_idx >= 0} {
3188                 set parent $unchanged_idx
3189             } else {
3190                 # blame the current commit
3191                 set parent -1
3192             }
3193         }
3194         # then count other lines that belong to it
3195         for {set i $line} {[incr i -1] > $s_lno} {} {
3196             set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3197             # Determine if the line is removed
3198             set removed_idx [string first "-" $chunk]
3199             if {$parent >= 0} {
3200                 set code [string index $chunk $parent]
3201                 if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3202                     incr dline
3203                 }
3204             } else {
3205                 if {$removed_idx < 0} {
3206                     incr dline
3207                 }
3208             }
3209         }
3210         incr parent
3211     } else {
3212         set parent 0
3213     }
3214
3215     incr dline [lindex $base_lines $parent]
3216     return [list $parent $dline]
3217 }
3218
3219 proc external_blame_diff {} {
3220     global currentid cmitmode
3221     global diff_menu_txtpos diff_menu_line
3222     global diff_menu_filebase flist_menu_file
3223
3224     if {$cmitmode eq "tree"} {
3225         set parent_idx 0
3226         set line [expr {$diff_menu_line - $diff_menu_filebase}]
3227     } else {
3228         set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3229         if {$hinfo ne {}} {
3230             set parent_idx [lindex $hinfo 0]
3231             set line [lindex $hinfo 1]
3232         } else {
3233             set parent_idx 0
3234             set line 0
3235         }
3236     }
3237
3238     external_blame $parent_idx $line
3239 }
3240
3241 proc external_blame {parent_idx {line {}}} {
3242     global flist_menu_file
3243     global nullid nullid2
3244     global parentlist selectedline currentid
3245
3246     if {$parent_idx > 0} {
3247         set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3248     } else {
3249         set base_commit $currentid
3250     }
3251
3252     if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3253         error_popup [mc "No such commit"]
3254         return
3255     }
3256
3257     set cmdline [list git gui blame]
3258     if {$line ne {} && $line > 1} {
3259         lappend cmdline "--line=$line"
3260     }
3261     lappend cmdline $base_commit $flist_menu_file
3262     if {[catch {eval exec $cmdline &} err]} {
3263         error_popup "[mc "git gui blame: command failed:"] $err"
3264     }
3265 }
3266
3267 proc show_line_source {} {
3268     global cmitmode currentid parents curview blamestuff blameinst
3269     global diff_menu_line diff_menu_filebase flist_menu_file
3270
3271     if {$cmitmode eq "tree"} {
3272         set id $currentid
3273         set line [expr {$diff_menu_line - $diff_menu_filebase}]
3274     } else {
3275         set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3276         if {$h eq {}} return
3277         set pi [lindex $h 0]
3278         if {$pi == 0} {
3279             mark_ctext_line $diff_menu_line
3280             return
3281         }
3282         set id [lindex $parents($curview,$currentid) [expr {$pi - 1}]]
3283         set line [lindex $h 1]
3284     }
3285     if {[catch {
3286         set f [open [list | git blame -p -L$line,+1 $id -- $flist_menu_file] r]
3287     } err]} {
3288         error_popup [mc "Couldn't start git blame: %s" $err]
3289         return
3290     }
3291     fconfigure $f -blocking 0
3292     set i [reg_instance $f]
3293     set blamestuff($i) {}
3294     set blameinst $i
3295     filerun $f [list read_line_source $f $i]
3296 }
3297
3298 proc stopblaming {} {
3299     global blameinst
3300
3301     if {[info exists blameinst]} {
3302         stop_instance $blameinst
3303         unset blameinst
3304     }
3305 }
3306
3307 proc read_line_source {fd inst} {
3308     global blamestuff curview commfd blameinst
3309
3310     while {[gets $fd line] >= 0} {
3311         lappend blamestuff($inst) $line
3312     }
3313     if {![eof $fd]} {
3314         return 1
3315     }
3316     unset commfd($inst)
3317     unset blameinst
3318     fconfigure $fd -blocking 1
3319     if {[catch {close $fd} err]} {
3320         error_popup [mc "Error running git blame: %s" $err]
3321         return 0
3322     }
3323
3324     set fname {}
3325     set line [split [lindex $blamestuff($inst) 0] " "]
3326     set id [lindex $line 0]
3327     set lnum [lindex $line 1]
3328     if {[string length $id] == 40 && [string is xdigit $id] &&
3329         [string is digit -strict $lnum]} {
3330         # look for "filename" line
3331         foreach l $blamestuff($inst) {
3332             if {[string match "filename *" $l]} {
3333                 set fname [string range $l 9 end]
3334                 break
3335             }
3336         }
3337     }
3338     if {$fname ne {}} {
3339         # all looks good, select it
3340         if {[commitinview $id $curview]} {
3341             selectline [rowofcommit $id] 1 [list $fname $lnum]
3342         } else {
3343             error_popup [mc "That line comes from commit %s, \
3344                              which is not in this view" [shortids $id]]
3345         }
3346     } else {
3347         puts "oops couldn't parse git blame output"
3348     }
3349     return 0
3350 }
3351
3352 # delete $dir when we see eof on $f (presumably because the child has exited)
3353 proc delete_at_eof {f dir} {
3354     while {[gets $f line] >= 0} {}
3355     if {[eof $f]} {
3356         if {[catch {close $f} err]} {
3357             error_popup "[mc "External diff viewer failed:"] $err"
3358         }
3359         file delete -force $dir
3360         return 0
3361     }
3362     return 1
3363 }
3364
3365 # Functions for adding and removing shell-type quoting
3366
3367 proc shellquote {str} {
3368     if {![string match "*\['\"\\ \t]*" $str]} {
3369         return $str
3370     }
3371     if {![string match "*\['\"\\]*" $str]} {
3372         return "\"$str\""
3373     }
3374     if {![string match "*'*" $str]} {
3375         return "'$str'"
3376     }
3377     return "\"[string map {\" \\\" \\ \\\\} $str]\""
3378 }
3379
3380 proc shellarglist {l} {
3381     set str {}
3382     foreach a $l {
3383         if {$str ne {}} {
3384             append str " "
3385         }
3386         append str [shellquote $a]
3387     }
3388     return $str
3389 }
3390
3391 proc shelldequote {str} {
3392     set ret {}
3393     set used -1
3394     while {1} {
3395         incr used
3396         if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
3397             append ret [string range $str $used end]
3398             set used [string length $str]
3399             break
3400         }
3401         set first [lindex $first 0]
3402         set ch [string index $str $first]
3403         if {$first > $used} {
3404             append ret [string range $str $used [expr {$first - 1}]]
3405             set used $first
3406         }
3407         if {$ch eq " " || $ch eq "\t"} break
3408         incr used
3409         if {$ch eq "'"} {
3410             set first [string first "'" $str $used]
3411             if {$first < 0} {
3412                 error "unmatched single-quote"
3413             }
3414             append ret [string range $str $used [expr {$first - 1}]]
3415             set used $first
3416             continue
3417         }
3418         if {$ch eq "\\"} {
3419             if {$used >= [string length $str]} {
3420                 error "trailing backslash"
3421             }
3422             append ret [string index $str $used]
3423             continue
3424         }
3425         # here ch == "\""
3426         while {1} {
3427             if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
3428                 error "unmatched double-quote"
3429             }
3430             set first [lindex $first 0]
3431             set ch [string index $str $first]
3432             if {$first > $used} {
3433                 append ret [string range $str $used [expr {$first - 1}]]
3434                 set used $first
3435             }
3436             if {$ch eq "\""} break
3437             incr used
3438             append ret [string index $str $used]
3439             incr used
3440         }
3441     }
3442     return [list $used $ret]
3443 }
3444
3445 proc shellsplit {str} {
3446     set l {}
3447     while {1} {
3448         set str [string trimleft $str]
3449         if {$str eq {}} break
3450         set dq [shelldequote $str]
3451         set n [lindex $dq 0]
3452         set word [lindex $dq 1]
3453         set str [string range $str $n end]
3454         lappend l $word
3455     }
3456     return $l
3457 }
3458
3459 # Code to implement multiple views
3460
3461 proc newview {ishighlight} {
3462     global nextviewnum newviewname newviewperm newishighlight
3463     global newviewargs revtreeargs viewargscmd newviewargscmd curview
3464
3465     set newishighlight $ishighlight
3466     set top .gitkview
3467     if {[winfo exists $top]} {
3468         raise $top
3469         return
3470     }
3471     set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
3472     set newviewperm($nextviewnum) 0
3473     set newviewargs($nextviewnum) [shellarglist $revtreeargs]
3474     set newviewargscmd($nextviewnum) $viewargscmd($curview)
3475     vieweditor $top $nextviewnum [mc "Gitk view definition"]
3476 }
3477
3478 proc editview {} {
3479     global curview
3480     global viewname viewperm newviewname newviewperm
3481     global viewargs newviewargs viewargscmd newviewargscmd
3482
3483     set top .gitkvedit-$curview
3484     if {[winfo exists $top]} {
3485         raise $top
3486         return
3487     }
3488     set newviewname($curview) $viewname($curview)
3489     set newviewperm($curview) $viewperm($curview)
3490     set newviewargs($curview) [shellarglist $viewargs($curview)]
3491     set newviewargscmd($curview) $viewargscmd($curview)
3492     vieweditor $top $curview "Gitk: edit view $viewname($curview)"
3493 }
3494
3495 proc vieweditor {top n title} {
3496     global newviewname newviewperm viewfiles bgcolor
3497
3498     toplevel $top
3499     wm title $top $title
3500     label $top.nl -text [mc "Name"]
3501     entry $top.name -width 20 -textvariable newviewname($n)
3502     grid $top.nl $top.name -sticky w -pady 5
3503     checkbutton $top.perm -text [mc "Remember this view"] \
3504         -variable newviewperm($n)
3505     grid $top.perm - -pady 5 -sticky w
3506     message $top.al -aspect 1000 \
3507         -text [mc "Commits to include (arguments to git log):"]
3508     grid $top.al - -sticky w -pady 5
3509     entry $top.args -width 50 -textvariable newviewargs($n) \
3510         -background $bgcolor
3511     grid $top.args - -sticky ew -padx 5
3512
3513     message $top.ac -aspect 1000 \
3514         -text [mc "Command to generate more commits to include:"]
3515     grid $top.ac - -sticky w -pady 5
3516     entry $top.argscmd -width 50 -textvariable newviewargscmd($n) \
3517         -background white
3518     grid $top.argscmd - -sticky ew -padx 5
3519
3520     message $top.l -aspect 1000 \
3521         -text [mc "Enter files and directories to include, one per line:"]
3522     grid $top.l - -sticky w
3523     text $top.t -width 40 -height 10 -background $bgcolor -font uifont
3524     if {[info exists viewfiles($n)]} {
3525         foreach f $viewfiles($n) {
3526             $top.t insert end $f
3527             $top.t insert end "\n"
3528         }
3529         $top.t delete {end - 1c} end
3530         $top.t mark set insert 0.0
3531     }
3532     grid $top.t - -sticky ew -padx 5
3533     frame $top.buts
3534     button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
3535     button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
3536     grid $top.buts.ok $top.buts.can
3537     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3538     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3539     grid $top.buts - -pady 10 -sticky ew
3540     focus $top.t
3541 }
3542
3543 proc doviewmenu {m first cmd op argv} {
3544     set nmenu [$m index end]
3545     for {set i $first} {$i <= $nmenu} {incr i} {
3546         if {[$m entrycget $i -command] eq $cmd} {
3547             eval $m $op $i $argv
3548             break
3549         }
3550     }
3551 }
3552
3553 proc allviewmenus {n op args} {
3554     # global viewhlmenu
3555
3556     doviewmenu .bar.view 5 [list showview $n] $op $args
3557     # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
3558 }
3559
3560 proc newviewok {top n} {
3561     global nextviewnum newviewperm newviewname newishighlight
3562     global viewname viewfiles viewperm selectedview curview
3563     global viewargs newviewargs viewargscmd newviewargscmd viewhlmenu
3564
3565     if {[catch {
3566         set newargs [shellsplit $newviewargs($n)]
3567     } err]} {
3568         error_popup "[mc "Error in commit selection arguments:"] $err"
3569         wm raise $top
3570         focus $top
3571         return
3572     }
3573     set files {}
3574     foreach f [split [$top.t get 0.0 end] "\n"] {
3575         set ft [string trim $f]
3576         if {$ft ne {}} {
3577             lappend files $ft
3578         }
3579     }
3580     if {![info exists viewfiles($n)]} {
3581         # creating a new view
3582         incr nextviewnum
3583         set viewname($n) $newviewname($n)
3584         set viewperm($n) $newviewperm($n)
3585         set viewfiles($n) $files
3586         set viewargs($n) $newargs
3587         set viewargscmd($n) $newviewargscmd($n)
3588         addviewmenu $n
3589         if {!$newishighlight} {
3590             run showview $n
3591         } else {
3592             run addvhighlight $n
3593         }
3594     } else {
3595         # editing an existing view
3596         set viewperm($n) $newviewperm($n)
3597         if {$newviewname($n) ne $viewname($n)} {
3598             set viewname($n) $newviewname($n)
3599             doviewmenu .bar.view 5 [list showview $n] \
3600                 entryconf [list -label $viewname($n)]
3601             # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
3602                 # entryconf [list -label $viewname($n) -value $viewname($n)]
3603         }
3604         if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
3605                 $newviewargscmd($n) ne $viewargscmd($n)} {
3606             set viewfiles($n) $files
3607             set viewargs($n) $newargs
3608             set viewargscmd($n) $newviewargscmd($n)
3609             if {$curview == $n} {
3610                 run reloadcommits
3611             }
3612         }
3613     }
3614     catch {destroy $top}
3615 }
3616
3617 proc delview {} {
3618     global curview viewperm hlview selectedhlview
3619
3620     if {$curview == 0} return
3621     if {[info exists hlview] && $hlview == $curview} {
3622         set selectedhlview [mc "None"]
3623         unset hlview
3624     }
3625     allviewmenus $curview delete
3626     set viewperm($curview) 0
3627     showview 0
3628 }
3629
3630 proc addviewmenu {n} {
3631     global viewname viewhlmenu
3632
3633     .bar.view add radiobutton -label $viewname($n) \
3634         -command [list showview $n] -variable selectedview -value $n
3635     #$viewhlmenu add radiobutton -label $viewname($n) \
3636     #   -command [list addvhighlight $n] -variable selectedhlview
3637 }
3638
3639 proc showview {n} {
3640     global curview cached_commitrow ordertok
3641     global displayorder parentlist rowidlist rowisopt rowfinal
3642     global colormap rowtextx nextcolor canvxmax
3643     global numcommits viewcomplete
3644     global selectedline currentid canv canvy0
3645     global treediffs
3646     global pending_select mainheadid
3647     global commitidx
3648     global selectedview
3649     global hlview selectedhlview commitinterest
3650
3651     if {$n == $curview} return
3652     set selid {}
3653     set ymax [lindex [$canv cget -scrollregion] 3]
3654     set span [$canv yview]
3655     set ytop [expr {[lindex $span 0] * $ymax}]
3656     set ybot [expr {[lindex $span 1] * $ymax}]
3657     set yscreen [expr {($ybot - $ytop) / 2}]
3658     if {$selectedline ne {}} {
3659         set selid $currentid
3660         set y [yc $selectedline]
3661         if {$ytop < $y && $y < $ybot} {
3662             set yscreen [expr {$y - $ytop}]
3663         }
3664     } elseif {[info exists pending_select]} {
3665         set selid $pending_select
3666         unset pending_select
3667     }
3668     unselectline
3669     normalline
3670     catch {unset treediffs}
3671     clear_display
3672     if {[info exists hlview] && $hlview == $n} {
3673         unset hlview
3674         set selectedhlview [mc "None"]
3675     }
3676     catch {unset commitinterest}
3677     catch {unset cached_commitrow}
3678     catch {unset ordertok}
3679
3680     set curview $n
3681     set selectedview $n
3682     .bar.view entryconf [mca "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
3683     .bar.view entryconf [mca "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
3684
3685     run refill_reflist
3686     if {![info exists viewcomplete($n)]} {
3687         getcommits $selid
3688         return
3689     }
3690
3691     set displayorder {}
3692     set parentlist {}
3693     set rowidlist {}
3694     set rowisopt {}
3695     set rowfinal {}
3696     set numcommits $commitidx($n)
3697
3698     catch {unset colormap}
3699     catch {unset rowtextx}
3700     set nextcolor 0
3701     set canvxmax [$canv cget -width]
3702     set curview $n
3703     set row 0
3704     setcanvscroll
3705     set yf 0
3706     set row {}
3707     if {$selid ne {} && [commitinview $selid $n]} {
3708         set row [rowofcommit $selid]
3709         # try to get the selected row in the same position on the screen
3710         set ymax [lindex [$canv cget -scrollregion] 3]
3711         set ytop [expr {[yc $row] - $yscreen}]
3712         if {$ytop < 0} {
3713             set ytop 0
3714         }
3715         set yf [expr {$ytop * 1.0 / $ymax}]
3716     }
3717     allcanvs yview moveto $yf
3718     drawvisible
3719     if {$row ne {}} {
3720         selectline $row 0
3721     } elseif {!$viewcomplete($n)} {
3722         reset_pending_select $selid
3723     } else {
3724         reset_pending_select {}
3725
3726         if {[commitinview $pending_select $curview]} {
3727             selectline [rowofcommit $pending_select] 1
3728         } else {
3729             set row [first_real_row]
3730             if {$row < $numcommits} {
3731                 selectline $row 0
3732             }
3733         }
3734     }
3735     if {!$viewcomplete($n)} {
3736         if {$numcommits == 0} {
3737             show_status [mc "Reading commits..."]
3738         }
3739     } elseif {$numcommits == 0} {
3740         show_status [mc "No commits selected"]
3741     }
3742 }
3743
3744 # Stuff relating to the highlighting facility
3745
3746 proc ishighlighted {id} {
3747     global vhighlights fhighlights nhighlights rhighlights
3748
3749     if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
3750         return $nhighlights($id)
3751     }
3752     if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
3753         return $vhighlights($id)
3754     }
3755     if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
3756         return $fhighlights($id)
3757     }
3758     if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
3759         return $rhighlights($id)
3760     }
3761     return 0
3762 }
3763
3764 proc bolden {row font} {
3765     global canv linehtag selectedline boldrows
3766
3767     lappend boldrows $row
3768     $canv itemconf $linehtag($row) -font $font
3769     if {$row == $selectedline} {
3770         $canv delete secsel
3771         set t [eval $canv create rect [$canv bbox $linehtag($row)] \
3772                    -outline {{}} -tags secsel \
3773                    -fill [$canv cget -selectbackground]]
3774         $canv lower $t
3775     }
3776 }
3777
3778 proc bolden_name {row font} {
3779     global canv2 linentag selectedline boldnamerows
3780
3781     lappend boldnamerows $row
3782     $canv2 itemconf $linentag($row) -font $font
3783     if {$row == $selectedline} {
3784         $canv2 delete secsel
3785         set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
3786                    -outline {{}} -tags secsel \
3787                    -fill [$canv2 cget -selectbackground]]
3788         $canv2 lower $t
3789     }
3790 }
3791
3792 proc unbolden {} {
3793     global boldrows
3794
3795     set stillbold {}
3796     foreach row $boldrows {
3797         if {![ishighlighted [commitonrow $row]]} {
3798             bolden $row mainfont
3799         } else {
3800             lappend stillbold $row
3801         }
3802     }
3803     set boldrows $stillbold
3804 }
3805
3806 proc addvhighlight {n} {
3807     global hlview viewcomplete curview vhl_done commitidx
3808
3809     if {[info exists hlview]} {
3810         delvhighlight
3811     }
3812     set hlview $n
3813     if {$n != $curview && ![info exists viewcomplete($n)]} {
3814         start_rev_list $n
3815     }
3816     set vhl_done $commitidx($hlview)
3817     if {$vhl_done > 0} {
3818         drawvisible
3819     }
3820 }
3821
3822 proc delvhighlight {} {
3823     global hlview vhighlights
3824
3825     if {![info exists hlview]} return
3826     unset hlview
3827     catch {unset vhighlights}
3828     unbolden
3829 }
3830
3831 proc vhighlightmore {} {
3832     global hlview vhl_done commitidx vhighlights curview
3833
3834     set max $commitidx($hlview)
3835     set vr [visiblerows]
3836     set r0 [lindex $vr 0]
3837     set r1 [lindex $vr 1]
3838     for {set i $vhl_done} {$i < $max} {incr i} {
3839         set id [commitonrow $i $hlview]
3840         if {[commitinview $id $curview]} {
3841             set row [rowofcommit $id]
3842             if {$r0 <= $row && $row <= $r1} {
3843                 if {![highlighted $row]} {
3844                     bolden $row mainfontbold
3845                 }
3846                 set vhighlights($id) 1
3847             }
3848         }
3849     }
3850     set vhl_done $max
3851     return 0
3852 }
3853
3854 proc askvhighlight {row id} {
3855     global hlview vhighlights iddrawn
3856
3857     if {[commitinview $id $hlview]} {
3858         if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
3859             bolden $row mainfontbold
3860         }
3861         set vhighlights($id) 1
3862     } else {
3863         set vhighlights($id) 0
3864     }
3865 }
3866
3867 proc hfiles_change {} {
3868     global highlight_files filehighlight fhighlights fh_serial
3869     global highlight_paths gdttype
3870
3871     if {[info exists filehighlight]} {
3872         # delete previous highlights
3873         catch {close $filehighlight}
3874         unset filehighlight
3875         catch {unset fhighlights}
3876         unbolden
3877         unhighlight_filelist
3878     }
3879     set highlight_paths {}
3880     after cancel do_file_hl $fh_serial
3881     incr fh_serial
3882     if {$highlight_files ne {}} {
3883         after 300 do_file_hl $fh_serial
3884     }
3885 }
3886
3887 proc gdttype_change {name ix op} {
3888     global gdttype highlight_files findstring findpattern
3889
3890     stopfinding
3891     if {$findstring ne {}} {
3892         if {$gdttype eq [mc "containing:"]} {
3893             if {$highlight_files ne {}} {
3894                 set highlight_files {}
3895                 hfiles_change
3896             }
3897             findcom_change
3898         } else {
3899             if {$findpattern ne {}} {
3900                 set findpattern {}
3901                 findcom_change
3902             }
3903             set highlight_files $findstring
3904             hfiles_change
3905         }
3906         drawvisible
3907     }
3908     # enable/disable findtype/findloc menus too
3909 }
3910
3911 proc find_change {name ix op} {
3912     global gdttype findstring highlight_files
3913
3914     stopfinding
3915     if {$gdttype eq [mc "containing:"]} {
3916         findcom_change
3917     } else {
3918         if {$highlight_files ne $findstring} {
3919             set highlight_files $findstring
3920             hfiles_change
3921         }
3922     }
3923     drawvisible
3924 }
3925
3926 proc findcom_change args {
3927     global nhighlights boldnamerows
3928     global findpattern findtype findstring gdttype
3929
3930     stopfinding
3931     # delete previous highlights, if any
3932     foreach row $boldnamerows {
3933         bolden_name $row mainfont
3934     }
3935     set boldnamerows {}
3936     catch {unset nhighlights}
3937     unbolden
3938     unmarkmatches
3939     if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
3940         set findpattern {}
3941     } elseif {$findtype eq [mc "Regexp"]} {
3942         set findpattern $findstring
3943     } else {
3944         set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
3945                    $findstring]
3946         set findpattern "*$e*"
3947     }
3948 }
3949
3950 proc makepatterns {l} {
3951     set ret {}
3952     foreach e $l {
3953         set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
3954         if {[string index $ee end] eq "/"} {
3955             lappend ret "$ee*"
3956         } else {
3957             lappend ret $ee
3958             lappend ret "$ee/*"
3959         }
3960     }
3961     return $ret
3962 }
3963
3964 proc do_file_hl {serial} {
3965     global highlight_files filehighlight highlight_paths gdttype fhl_list
3966
3967     if {$gdttype eq [mc "touching paths:"]} {
3968         if {[catch {set paths [shellsplit $highlight_files]}]} return
3969         set highlight_paths [makepatterns $paths]
3970         highlight_filelist
3971         set gdtargs [concat -- $paths]
3972     } elseif {$gdttype eq [mc "adding/removing string:"]} {
3973         set gdtargs [list "-S$highlight_files"]
3974     } else {
3975         # must be "containing:", i.e. we're searching commit info
3976         return
3977     }
3978     set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
3979     set filehighlight [open $cmd r+]
3980     fconfigure $filehighlight -blocking 0
3981     filerun $filehighlight readfhighlight
3982     set fhl_list {}
3983     drawvisible
3984     flushhighlights
3985 }
3986
3987 proc flushhighlights {} {
3988     global filehighlight fhl_list
3989
3990     if {[info exists filehighlight]} {
3991         lappend fhl_list {}
3992         puts $filehighlight ""
3993         flush $filehighlight
3994     }
3995 }
3996
3997 proc askfilehighlight {row id} {
3998     global filehighlight fhighlights fhl_list
3999
4000     lappend fhl_list $id
4001     set fhighlights($id) -1
4002     puts $filehighlight $id
4003 }
4004
4005 proc readfhighlight {} {
4006     global filehighlight fhighlights curview iddrawn
4007     global fhl_list find_dirn
4008
4009     if {![info exists filehighlight]} {
4010         return 0
4011     }
4012     set nr 0
4013     while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4014         set line [string trim $line]
4015         set i [lsearch -exact $fhl_list $line]
4016         if {$i < 0} continue
4017         for {set j 0} {$j < $i} {incr j} {
4018             set id [lindex $fhl_list $j]
4019             set fhighlights($id) 0
4020         }
4021         set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4022         if {$line eq {}} continue
4023         if {![commitinview $line $curview]} continue
4024         set row [rowofcommit $line]
4025         if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4026             bolden $row mainfontbold
4027         }
4028         set fhighlights($line) 1
4029     }
4030     if {[eof $filehighlight]} {
4031         # strange...
4032         puts "oops, git diff-tree died"
4033         catch {close $filehighlight}
4034         unset filehighlight
4035         return 0
4036     }
4037     if {[info exists find_dirn]} {
4038         run findmore
4039     }
4040     return 1
4041 }
4042
4043 proc doesmatch {f} {
4044     global findtype findpattern
4045
4046     if {$findtype eq [mc "Regexp"]} {
4047         return [regexp $findpattern $f]
4048     } elseif {$findtype eq [mc "IgnCase"]} {
4049         return [string match -nocase $findpattern $f]
4050     } else {
4051         return [string match $findpattern $f]
4052     }
4053 }
4054
4055 proc askfindhighlight {row id} {
4056     global nhighlights commitinfo iddrawn
4057     global findloc
4058     global markingmatches
4059
4060     if {![info exists commitinfo($id)]} {
4061         getcommit $id
4062     }
4063     set info $commitinfo($id)
4064     set isbold 0
4065     set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
4066     foreach f $info ty $fldtypes {
4067         if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4068             [doesmatch $f]} {
4069             if {$ty eq [mc "Author"]} {
4070                 set isbold 2
4071                 break
4072             }
4073             set isbold 1
4074         }
4075     }
4076     if {$isbold && [info exists iddrawn($id)]} {
4077         if {![ishighlighted $id]} {
4078             bolden $row mainfontbold
4079             if {$isbold > 1} {
4080                 bolden_name $row mainfontbold
4081             }
4082         }
4083         if {$markingmatches} {
4084             markrowmatches $row $id
4085         }
4086     }
4087     set nhighlights($id) $isbold
4088 }
4089
4090 proc markrowmatches {row id} {
4091     global canv canv2 linehtag linentag commitinfo findloc
4092
4093     set headline [lindex $commitinfo($id) 0]
4094     set author [lindex $commitinfo($id) 1]
4095     $canv delete match$row
4096     $canv2 delete match$row
4097     if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4098         set m [findmatches $headline]
4099         if {$m ne {}} {
4100             markmatches $canv $row $headline $linehtag($row) $m \
4101                 [$canv itemcget $linehtag($row) -font] $row
4102         }
4103     }
4104     if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4105         set m [findmatches $author]
4106         if {$m ne {}} {
4107             markmatches $canv2 $row $author $linentag($row) $m \
4108                 [$canv2 itemcget $linentag($row) -font] $row
4109         }
4110     }
4111 }
4112
4113 proc vrel_change {name ix op} {
4114     global highlight_related
4115
4116     rhighlight_none
4117     if {$highlight_related ne [mc "None"]} {
4118         run drawvisible
4119     }
4120 }
4121
4122 # prepare for testing whether commits are descendents or ancestors of a
4123 proc rhighlight_sel {a} {
4124     global descendent desc_todo ancestor anc_todo
4125     global highlight_related
4126
4127     catch {unset descendent}
4128     set desc_todo [list $a]
4129     catch {unset ancestor}
4130     set anc_todo [list $a]
4131     if {$highlight_related ne [mc "None"]} {
4132         rhighlight_none
4133         run drawvisible
4134     }
4135 }
4136
4137 proc rhighlight_none {} {
4138     global rhighlights
4139
4140     catch {unset rhighlights}
4141     unbolden
4142 }
4143
4144 proc is_descendent {a} {
4145     global curview children descendent desc_todo
4146
4147     set v $curview
4148     set la [rowofcommit $a]
4149     set todo $desc_todo
4150     set leftover {}
4151     set done 0
4152     for {set i 0} {$i < [llength $todo]} {incr i} {
4153         set do [lindex $todo $i]
4154         if {[rowofcommit $do] < $la} {
4155             lappend leftover $do
4156             continue
4157         }
4158         foreach nk $children($v,$do) {
4159             if {![info exists descendent($nk)]} {
4160                 set descendent($nk) 1
4161                 lappend todo $nk
4162                 if {$nk eq $a} {
4163                     set done 1
4164                 }
4165             }
4166         }
4167         if {$done} {
4168             set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4169             return
4170         }
4171     }
4172     set descendent($a) 0
4173     set desc_todo $leftover
4174 }
4175
4176 proc is_ancestor {a} {
4177     global curview parents ancestor anc_todo
4178
4179     set v $curview
4180     set la [rowofcommit $a]
4181     set todo $anc_todo
4182     set leftover {}
4183     set done 0
4184     for {set i 0} {$i < [llength $todo]} {incr i} {
4185         set do [lindex $todo $i]
4186         if {![commitinview $do $v] || [rowofcommit $do] > $la} {
4187             lappend leftover $do
4188             continue
4189         }
4190         foreach np $parents($v,$do) {
4191             if {![info exists ancestor($np)]} {
4192                 set ancestor($np) 1
4193                 lappend todo $np
4194                 if {$np eq $a} {
4195                     set done 1
4196                 }
4197             }
4198         }
4199         if {$done} {
4200             set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4201             return
4202         }
4203     }
4204     set ancestor($a) 0
4205     set anc_todo $leftover
4206 }
4207
4208 proc askrelhighlight {row id} {
4209     global descendent highlight_related iddrawn rhighlights
4210     global selectedline ancestor
4211
4212     if {$selectedline eq {}} return
4213     set isbold 0
4214     if {$highlight_related eq [mc "Descendant"] ||
4215         $highlight_related eq [mc "Not descendant"]} {
4216         if {![info exists descendent($id)]} {
4217             is_descendent $id
4218         }
4219         if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
4220             set isbold 1
4221         }
4222     } elseif {$highlight_related eq [mc "Ancestor"] ||
4223               $highlight_related eq [mc "Not ancestor"]} {
4224         if {![info exists ancestor($id)]} {
4225             is_ancestor $id
4226         }
4227         if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
4228             set isbold 1
4229         }
4230     }
4231     if {[info exists iddrawn($id)]} {
4232         if {$isbold && ![ishighlighted $id]} {
4233             bolden $row mainfontbold
4234         }
4235     }
4236     set rhighlights($id) $isbold
4237 }
4238
4239 # Graph layout functions
4240
4241 proc shortids {ids} {
4242     set res {}
4243     foreach id $ids {
4244         if {[llength $id] > 1} {
4245             lappend res [shortids $id]
4246         } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
4247             lappend res [string range $id 0 7]
4248         } else {
4249             lappend res $id
4250         }
4251     }
4252     return $res
4253 }
4254
4255 proc ntimes {n o} {
4256     set ret {}
4257     set o [list $o]
4258     for {set mask 1} {$mask <= $n} {incr mask $mask} {
4259         if {($n & $mask) != 0} {
4260             set ret [concat $ret $o]
4261         }
4262         set o [concat $o $o]
4263     }
4264     return $ret
4265 }
4266
4267 proc ordertoken {id} {
4268     global ordertok curview varcid varcstart varctok curview parents children
4269     global nullid nullid2
4270
4271     if {[info exists ordertok($id)]} {
4272         return $ordertok($id)
4273     }
4274     set origid $id
4275     set todo {}
4276     while {1} {
4277         if {[info exists varcid($curview,$id)]} {
4278             set a $varcid($curview,$id)
4279             set p [lindex $varcstart($curview) $a]
4280         } else {
4281             set p [lindex $children($curview,$id) 0]
4282         }
4283         if {[info exists ordertok($p)]} {
4284             set tok $ordertok($p)
4285             break
4286         }
4287         set id [first_real_child $curview,$p]
4288         if {$id eq {}} {
4289             # it's a root
4290             set tok [lindex $varctok($curview) $varcid($curview,$p)]
4291             break
4292         }
4293         if {[llength $parents($curview,$id)] == 1} {
4294             lappend todo [list $p {}]
4295         } else {
4296             set j [lsearch -exact $parents($curview,$id) $p]
4297             if {$j < 0} {
4298                 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
4299             }
4300             lappend todo [list $p [strrep $j]]
4301         }
4302     }
4303     for {set i [llength $todo]} {[incr i -1] >= 0} {} {
4304         set p [lindex $todo $i 0]
4305         append tok [lindex $todo $i 1]
4306         set ordertok($p) $tok
4307     }
4308     set ordertok($origid) $tok
4309     return $tok
4310 }
4311
4312 # Work out where id should go in idlist so that order-token
4313 # values increase from left to right
4314 proc idcol {idlist id {i 0}} {
4315     set t [ordertoken $id]
4316     if {$i < 0} {
4317         set i 0
4318     }
4319     if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
4320         if {$i > [llength $idlist]} {
4321             set i [llength $idlist]
4322         }
4323         while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
4324         incr i
4325     } else {
4326         if {$t > [ordertoken [lindex $idlist $i]]} {
4327             while {[incr i] < [llength $idlist] &&
4328                    $t >= [ordertoken [lindex $idlist $i]]} {}
4329         }
4330     }
4331     return $i
4332 }
4333
4334 proc initlayout {} {
4335     global rowidlist rowisopt rowfinal displayorder parentlist
4336     global numcommits canvxmax canv
4337     global nextcolor
4338     global colormap rowtextx
4339
4340     set numcommits 0
4341     set displayorder {}
4342     set parentlist {}
4343     set nextcolor 0
4344     set rowidlist {}
4345     set rowisopt {}
4346     set rowfinal {}
4347     set canvxmax [$canv cget -width]
4348     catch {unset colormap}
4349     catch {unset rowtextx}
4350     setcanvscroll
4351 }
4352
4353 proc setcanvscroll {} {
4354     global canv canv2 canv3 numcommits linespc canvxmax canvy0
4355     global lastscrollset lastscrollrows
4356
4357     set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
4358     $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
4359     $canv2 conf -scrollregion [list 0 0 0 $ymax]
4360     $canv3 conf -scrollregion [list 0 0 0 $ymax]
4361     set lastscrollset [clock clicks -milliseconds]
4362     set lastscrollrows $numcommits
4363 }
4364
4365 proc visiblerows {} {
4366     global canv numcommits linespc
4367
4368     set ymax [lindex [$canv cget -scrollregion] 3]
4369     if {$ymax eq {} || $ymax == 0} return
4370     set f [$canv yview]
4371     set y0 [expr {int([lindex $f 0] * $ymax)}]
4372     set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
4373     if {$r0 < 0} {
4374         set r0 0
4375     }
4376     set y1 [expr {int([lindex $f 1] * $ymax)}]
4377     set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
4378     if {$r1 >= $numcommits} {
4379         set r1 [expr {$numcommits - 1}]
4380     }
4381     return [list $r0 $r1]
4382 }
4383
4384 proc layoutmore {} {
4385     global commitidx viewcomplete curview
4386     global numcommits pending_select curview
4387     global lastscrollset lastscrollrows
4388
4389     if {$lastscrollrows < 100 || $viewcomplete($curview) ||
4390         [clock clicks -milliseconds] - $lastscrollset > 500} {
4391         setcanvscroll
4392     }
4393     if {[info exists pending_select] &&
4394         [commitinview $pending_select $curview]} {
4395         update
4396         selectline [rowofcommit $pending_select] 1
4397     }
4398     drawvisible
4399 }
4400
4401 proc doshowlocalchanges {} {
4402     global curview mainheadid
4403
4404     if {$mainheadid eq {}} return
4405     if {[commitinview $mainheadid $curview]} {
4406         dodiffindex
4407     } else {
4408         interestedin $mainheadid dodiffindex
4409     }
4410 }
4411
4412 proc dohidelocalchanges {} {
4413     global nullid nullid2 lserial curview
4414
4415     if {[commitinview $nullid $curview]} {
4416         removefakerow $nullid
4417     }
4418     if {[commitinview $nullid2 $curview]} {
4419         removefakerow $nullid2
4420     }
4421     incr lserial
4422 }
4423
4424 # spawn off a process to do git diff-index --cached HEAD
4425 proc dodiffindex {} {
4426     global lserial showlocalchanges
4427     global isworktree
4428
4429     if {!$showlocalchanges || !$isworktree} return
4430     incr lserial
4431     set fd [open "|git diff-index --cached HEAD" r]
4432     fconfigure $fd -blocking 0
4433     set i [reg_instance $fd]
4434     filerun $fd [list readdiffindex $fd $lserial $i]
4435 }
4436
4437 proc readdiffindex {fd serial inst} {
4438     global mainheadid nullid nullid2 curview commitinfo commitdata lserial
4439
4440     set isdiff 1
4441     if {[gets $fd line] < 0} {
4442         if {![eof $fd]} {
4443             return 1
4444         }
4445         set isdiff 0
4446     }
4447     # we only need to see one line and we don't really care what it says...
4448     stop_instance $inst
4449
4450     if {$serial != $lserial} {
4451         return 0
4452     }
4453
4454     # now see if there are any local changes not checked in to the index
4455     set fd [open "|git diff-files" r]
4456     fconfigure $fd -blocking 0
4457     set i [reg_instance $fd]
4458     filerun $fd [list readdifffiles $fd $serial $i]
4459
4460     if {$isdiff && ![commitinview $nullid2 $curview]} {
4461         # add the line for the changes in the index to the graph
4462         set hl [mc "Local changes checked in to index but not committed"]
4463         set commitinfo($nullid2) [list  $hl {} {} {} {} "    $hl\n"]
4464         set commitdata($nullid2) "\n    $hl\n"
4465         if {[commitinview $nullid $curview]} {
4466             removefakerow $nullid
4467         }
4468         insertfakerow $nullid2 $mainheadid
4469     } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
4470         removefakerow $nullid2
4471     }
4472     return 0
4473 }
4474
4475 proc readdifffiles {fd serial inst} {
4476     global mainheadid nullid nullid2 curview
4477     global commitinfo commitdata lserial
4478
4479     set isdiff 1
4480     if {[gets $fd line] < 0} {
4481         if {![eof $fd]} {
4482             return 1
4483         }
4484         set isdiff 0
4485     }
4486     # we only need to see one line and we don't really care what it says...
4487     stop_instance $inst
4488
4489     if {$serial != $lserial} {
4490         return 0
4491     }
4492
4493     if {$isdiff && ![commitinview $nullid $curview]} {
4494         # add the line for the local diff to the graph
4495         set hl [mc "Local uncommitted changes, not checked in to index"]
4496         set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
4497         set commitdata($nullid) "\n    $hl\n"
4498         if {[commitinview $nullid2 $curview]} {
4499             set p $nullid2
4500         } else {
4501             set p $mainheadid
4502         }
4503         insertfakerow $nullid $p
4504     } elseif {!$isdiff && [commitinview $nullid $curview]} {
4505         removefakerow $nullid
4506     }
4507     return 0
4508 }
4509
4510 proc nextuse {id row} {
4511     global curview children
4512
4513     if {[info exists children($curview,$id)]} {
4514         foreach kid $children($curview,$id) {
4515             if {![commitinview $kid $curview]} {
4516                 return -1
4517             }
4518             if {[rowofcommit $kid] > $row} {
4519                 return [rowofcommit $kid]
4520             }
4521         }
4522     }
4523     if {[commitinview $id $curview]} {
4524         return [rowofcommit $id]
4525     }
4526     return -1
4527 }
4528
4529 proc prevuse {id row} {
4530     global curview children
4531
4532     set ret -1
4533     if {[info exists children($curview,$id)]} {
4534         foreach kid $children($curview,$id) {
4535             if {![commitinview $kid $curview]} break
4536             if {[rowofcommit $kid] < $row} {
4537                 set ret [rowofcommit $kid]
4538             }
4539         }
4540     }
4541     return $ret
4542 }
4543
4544 proc make_idlist {row} {
4545     global displayorder parentlist uparrowlen downarrowlen mingaplen
4546     global commitidx curview children
4547
4548     set r [expr {$row - $mingaplen - $downarrowlen - 1}]
4549     if {$r < 0} {
4550         set r 0
4551     }
4552     set ra [expr {$row - $downarrowlen}]
4553     if {$ra < 0} {
4554         set ra 0
4555     }
4556     set rb [expr {$row + $uparrowlen}]
4557     if {$rb > $commitidx($curview)} {
4558         set rb $commitidx($curview)
4559     }
4560     make_disporder $r [expr {$rb + 1}]
4561     set ids {}
4562     for {} {$r < $ra} {incr r} {
4563         set nextid [lindex $displayorder [expr {$r + 1}]]
4564         foreach p [lindex $parentlist $r] {
4565             if {$p eq $nextid} continue
4566             set rn [nextuse $p $r]
4567             if {$rn >= $row &&
4568                 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
4569                 lappend ids [list [ordertoken $p] $p]
4570             }
4571         }
4572     }
4573     for {} {$r < $row} {incr r} {
4574         set nextid [lindex $displayorder [expr {$r + 1}]]
4575         foreach p [lindex $parentlist $r] {
4576             if {$p eq $nextid} continue
4577             set rn [nextuse $p $r]
4578             if {$rn < 0 || $rn >= $row} {
4579                 lappend ids [list [ordertoken $p] $p]
4580             }
4581         }
4582     }
4583     set id [lindex $displayorder $row]
4584     lappend ids [list [ordertoken $id] $id]
4585     while {$r < $rb} {
4586         foreach p [lindex $parentlist $r] {
4587             set firstkid [lindex $children($curview,$p) 0]
4588             if {[rowofcommit $firstkid] < $row} {
4589                 lappend ids [list [ordertoken $p] $p]
4590             }
4591         }
4592         incr r
4593         set id [lindex $displayorder $r]
4594         if {$id ne {}} {
4595             set firstkid [lindex $children($curview,$id) 0]
4596             if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
4597                 lappend ids [list [ordertoken $id] $id]
4598             }
4599         }
4600     }
4601     set idlist {}
4602     foreach idx [lsort -unique $ids] {
4603         lappend idlist [lindex $idx 1]
4604     }
4605     return $idlist
4606 }
4607
4608 proc rowsequal {a b} {
4609     while {[set i [lsearch -exact $a {}]] >= 0} {
4610         set a [lreplace $a $i $i]
4611     }
4612     while {[set i [lsearch -exact $b {}]] >= 0} {
4613         set b [lreplace $b $i $i]
4614     }
4615     return [expr {$a eq $b}]
4616 }
4617
4618 proc makeupline {id row rend col} {
4619     global rowidlist uparrowlen downarrowlen mingaplen
4620
4621     for {set r $rend} {1} {set r $rstart} {
4622         set rstart [prevuse $id $r]
4623         if {$rstart < 0} return
4624         if {$rstart < $row} break
4625     }
4626     if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
4627         set rstart [expr {$rend - $uparrowlen - 1}]
4628     }
4629     for {set r $rstart} {[incr r] <= $row} {} {
4630         set idlist [lindex $rowidlist $r]
4631         if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
4632             set col [idcol $idlist $id $col]
4633             lset rowidlist $r [linsert $idlist $col $id]
4634             changedrow $r
4635         }
4636     }
4637 }
4638
4639 proc layoutrows {row endrow} {
4640     global rowidlist rowisopt rowfinal displayorder
4641     global uparrowlen downarrowlen maxwidth mingaplen
4642     global children parentlist
4643     global commitidx viewcomplete curview
4644
4645     make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
4646     set idlist {}
4647     if {$row > 0} {
4648         set rm1 [expr {$row - 1}]
4649         foreach id [lindex $rowidlist $rm1] {
4650             if {$id ne {}} {
4651                 lappend idlist $id
4652             }
4653         }
4654         set final [lindex $rowfinal $rm1]
4655     }
4656     for {} {$row < $endrow} {incr row} {
4657         set rm1 [expr {$row - 1}]
4658         if {$rm1 < 0 || $idlist eq {}} {
4659             set idlist [make_idlist $row]
4660             set final 1
4661         } else {
4662             set id [lindex $displayorder $rm1]
4663             set col [lsearch -exact $idlist $id]
4664             set idlist [lreplace $idlist $col $col]
4665             foreach p [lindex $parentlist $rm1] {
4666                 if {[lsearch -exact $idlist $p] < 0} {
4667                     set col [idcol $idlist $p $col]
4668                     set idlist [linsert $idlist $col $p]
4669                     # if not the first child, we have to insert a line going up
4670                     if {$id ne [lindex $children($curview,$p) 0]} {
4671                         makeupline $p $rm1 $row $col
4672                     }
4673                 }
4674             }
4675             set id [lindex $displayorder $row]
4676             if {$row > $downarrowlen} {
4677                 set termrow [expr {$row - $downarrowlen - 1}]
4678                 foreach p [lindex $parentlist $termrow] {
4679                     set i [lsearch -exact $idlist $p]
4680                     if {$i < 0} continue
4681                     set nr [nextuse $p $termrow]
4682                     if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
4683                         set idlist [lreplace $idlist $i $i]
4684                     }
4685                 }
4686             }
4687             set col [lsearch -exact $idlist $id]
4688             if {$col < 0} {
4689                 set col [idcol $idlist $id]
4690                 set idlist [linsert $idlist $col $id]
4691                 if {$children($curview,$id) ne {}} {
4692                     makeupline $id $rm1 $row $col
4693                 }
4694             }
4695             set r [expr {$row + $uparrowlen - 1}]
4696             if {$r < $commitidx($curview)} {
4697                 set x $col
4698                 foreach p [lindex $parentlist $r] {
4699                     if {[lsearch -exact $idlist $p] >= 0} continue
4700                     set fk [lindex $children($curview,$p) 0]
4701                     if {[rowofcommit $fk] < $row} {
4702                         set x [idcol $idlist $p $x]
4703                         set idlist [linsert $idlist $x $p]
4704                     }
4705                 }
4706                 if {[incr r] < $commitidx($curview)} {
4707                     set p [lindex $displayorder $r]
4708                     if {[lsearch -exact $idlist $p] < 0} {
4709                         set fk [lindex $children($curview,$p) 0]
4710                         if {$fk ne {} && [rowofcommit $fk] < $row} {
4711                             set x [idcol $idlist $p $x]
4712                             set idlist [linsert $idlist $x $p]
4713                         }
4714                     }
4715                 }
4716             }
4717         }
4718         if {$final && !$viewcomplete($curview) &&
4719             $row + $uparrowlen + $mingaplen + $downarrowlen
4720                 >= $commitidx($curview)} {
4721             set final 0
4722         }
4723         set l [llength $rowidlist]
4724         if {$row == $l} {
4725             lappend rowidlist $idlist
4726             lappend rowisopt 0
4727             lappend rowfinal $final
4728         } elseif {$row < $l} {
4729             if {![rowsequal $idlist [lindex $rowidlist $row]]} {
4730                 lset rowidlist $row $idlist
4731                 changedrow $row
4732             }
4733             lset rowfinal $row $final
4734         } else {
4735             set pad [ntimes [expr {$row - $l}] {}]
4736             set rowidlist [concat $rowidlist $pad]
4737             lappend rowidlist $idlist
4738             set rowfinal [concat $rowfinal $pad]
4739             lappend rowfinal $final
4740             set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
4741         }
4742     }
4743     return $row
4744 }
4745
4746 proc changedrow {row} {
4747     global displayorder iddrawn rowisopt need_redisplay
4748
4749     set l [llength $rowisopt]
4750     if {$row < $l} {
4751         lset rowisopt $row 0
4752         if {$row + 1 < $l} {
4753             lset rowisopt [expr {$row + 1}] 0
4754             if {$row + 2 < $l} {
4755                 lset rowisopt [expr {$row + 2}] 0
4756             }
4757         }
4758     }
4759     set id [lindex $displayorder $row]
4760     if {[info exists iddrawn($id)]} {
4761         set need_redisplay 1
4762     }
4763 }
4764
4765 proc insert_pad {row col npad} {
4766     global rowidlist
4767
4768     set pad [ntimes $npad {}]
4769     set idlist [lindex $rowidlist $row]
4770     set bef [lrange $idlist 0 [expr {$col - 1}]]
4771     set aft [lrange $idlist $col end]
4772     set i [lsearch -exact $aft {}]
4773     if {$i > 0} {
4774         set aft [lreplace $aft $i $i]
4775     }
4776     lset rowidlist $row [concat $bef $pad $aft]
4777     changedrow $row
4778 }
4779
4780 proc optimize_rows {row col endrow} {
4781     global rowidlist rowisopt displayorder curview children
4782
4783     if {$row < 1} {
4784         set row 1
4785     }
4786     for {} {$row < $endrow} {incr row; set col 0} {
4787         if {[lindex $rowisopt $row]} continue
4788         set haspad 0
4789         set y0 [expr {$row - 1}]
4790         set ym [expr {$row - 2}]
4791         set idlist [lindex $rowidlist $row]
4792         set previdlist [lindex $rowidlist $y0]
4793         if {$idlist eq {} || $previdlist eq {}} continue
4794         if {$ym >= 0} {
4795             set pprevidlist [lindex $rowidlist $ym]
4796             if {$pprevidlist eq {}} continue
4797         } else {
4798             set pprevidlist {}
4799         }
4800         set x0 -1
4801         set xm -1
4802         for {} {$col < [llength $idlist]} {incr col} {
4803             set id [lindex $idlist $col]
4804             if {[lindex $previdlist $col] eq $id} continue
4805             if {$id eq {}} {
4806                 set haspad 1
4807                 continue
4808             }
4809             set x0 [lsearch -exact $previdlist $id]
4810             if {$x0 < 0} continue
4811             set z [expr {$x0 - $col}]
4812             set isarrow 0
4813             set z0 {}
4814             if {$ym >= 0} {
4815                 set xm [lsearch -exact $pprevidlist $id]
4816                 if {$xm >= 0} {
4817                     set z0 [expr {$xm - $x0}]
4818                 }
4819             }
4820             if {$z0 eq {}} {
4821                 # if row y0 is the first child of $id then it's not an arrow
4822                 if {[lindex $children($curview,$id) 0] ne
4823                     [lindex $displayorder $y0]} {
4824                     set isarrow 1
4825                 }
4826             }
4827             if {!$isarrow && $id ne [lindex $displayorder $row] &&
4828                 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
4829                 set isarrow 1
4830             }
4831             # Looking at lines from this row to the previous row,
4832             # make them go straight up if they end in an arrow on
4833             # the previous row; otherwise make them go straight up
4834             # or at 45 degrees.
4835             if {$z < -1 || ($z < 0 && $isarrow)} {
4836                 # Line currently goes left too much;
4837                 # insert pads in the previous row, then optimize it
4838                 set npad [expr {-1 - $z + $isarrow}]
4839                 insert_pad $y0 $x0 $npad
4840                 if {$y0 > 0} {
4841                     optimize_rows $y0 $x0 $row
4842                 }
4843                 set previdlist [lindex $rowidlist $y0]
4844                 set x0 [lsearch -exact $previdlist $id]
4845                 set z [expr {$x0 - $col}]
4846                 if {$z0 ne {}} {
4847                     set pprevidlist [lindex $rowidlist $ym]
4848                     set xm [lsearch -exact $pprevidlist $id]
4849                     set z0 [expr {$xm - $x0}]
4850                 }
4851             } elseif {$z > 1 || ($z > 0 && $isarrow)} {
4852                 # Line currently goes right too much;
4853                 # insert pads in this line
4854                 set npad [expr {$z - 1 + $isarrow}]
4855                 insert_pad $row $col $npad
4856                 set idlist [lindex $rowidlist $row]
4857                 incr col $npad
4858                 set z [expr {$x0 - $col}]
4859                 set haspad 1
4860             }
4861             if {$z0 eq {} && !$isarrow && $ym >= 0} {
4862                 # this line links to its first child on row $row-2
4863                 set id [lindex $displayorder $ym]
4864                 set xc [lsearch -exact $pprevidlist $id]
4865                 if {$xc >= 0} {
4866                     set z0 [expr {$xc - $x0}]
4867                 }
4868             }
4869             # avoid lines jigging left then immediately right
4870             if {$z0 ne {} && $z < 0 && $z0 > 0} {
4871                 insert_pad $y0 $x0 1
4872                 incr x0
4873                 optimize_rows $y0 $x0 $row
4874                 set previdlist [lindex $rowidlist $y0]
4875             }
4876         }
4877         if {!$haspad} {
4878             # Find the first column that doesn't have a line going right
4879             for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
4880                 set id [lindex $idlist $col]
4881                 if {$id eq {}} break
4882                 set x0 [lsearch -exact $previdlist $id]
4883                 if {$x0 < 0} {
4884                     # check if this is the link to the first child
4885                     set kid [lindex $displayorder $y0]
4886                     if {[lindex $children($curview,$id) 0] eq $kid} {
4887                         # it is, work out offset to child
4888                         set x0 [lsearch -exact $previdlist $kid]
4889                     }
4890                 }
4891                 if {$x0 <= $col} break
4892             }
4893             # Insert a pad at that column as long as it has a line and
4894             # isn't the last column
4895             if {$x0 >= 0 && [incr col] < [llength $idlist]} {
4896                 set idlist [linsert $idlist $col {}]
4897                 lset rowidlist $row $idlist
4898                 changedrow $row
4899             }
4900         }
4901     }
4902 }
4903
4904 proc xc {row col} {
4905     global canvx0 linespc
4906     return [expr {$canvx0 + $col * $linespc}]
4907 }
4908
4909 proc yc {row} {
4910     global canvy0 linespc
4911     return [expr {$canvy0 + $row * $linespc}]
4912 }
4913
4914 proc linewidth {id} {
4915     global thickerline lthickness
4916
4917     set wid $lthickness
4918     if {[info exists thickerline] && $id eq $thickerline} {
4919         set wid [expr {2 * $lthickness}]
4920     }
4921     return $wid
4922 }
4923
4924 proc rowranges {id} {
4925     global curview children uparrowlen downarrowlen
4926     global rowidlist
4927
4928     set kids $children($curview,$id)
4929     if {$kids eq {}} {
4930         return {}
4931     }
4932     set ret {}
4933     lappend kids $id
4934     foreach child $kids {
4935         if {![commitinview $child $curview]} break
4936         set row [rowofcommit $child]
4937         if {![info exists prev]} {
4938             lappend ret [expr {$row + 1}]
4939         } else {
4940             if {$row <= $prevrow} {
4941                 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
4942             }
4943             # see if the line extends the whole way from prevrow to row
4944             if {$row > $prevrow + $uparrowlen + $downarrowlen &&
4945                 [lsearch -exact [lindex $rowidlist \
4946                             [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
4947                 # it doesn't, see where it ends
4948                 set r [expr {$prevrow + $downarrowlen}]
4949                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
4950                     while {[incr r -1] > $prevrow &&
4951                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
4952                 } else {
4953                     while {[incr r] <= $row &&
4954                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
4955                     incr r -1
4956                 }
4957                 lappend ret $r
4958                 # see where it starts up again
4959                 set r [expr {$row - $uparrowlen}]
4960                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
4961                     while {[incr r] < $row &&
4962                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
4963                 } else {
4964                     while {[incr r -1] >= $prevrow &&
4965                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
4966                     incr r
4967                 }
4968                 lappend ret $r
4969             }
4970         }
4971         if {$child eq $id} {
4972             lappend ret $row
4973         }
4974         set prev $child
4975         set prevrow $row
4976     }
4977     return $ret
4978 }
4979
4980 proc drawlineseg {id row endrow arrowlow} {
4981     global rowidlist displayorder iddrawn linesegs
4982     global canv colormap linespc curview maxlinelen parentlist
4983
4984     set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
4985     set le [expr {$row + 1}]
4986     set arrowhigh 1
4987     while {1} {
4988         set c [lsearch -exact [lindex $rowidlist $le] $id]
4989         if {$c < 0} {
4990             incr le -1
4991             break
4992         }
4993         lappend cols $c
4994         set x [lindex $displayorder $le]
4995         if {$x eq $id} {
4996             set arrowhigh 0
4997             break
4998         }
4999         if {[info exists iddrawn($x)] || $le == $endrow} {
5000             set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5001             if {$c >= 0} {
5002                 lappend cols $c
5003                 set arrowhigh 0
5004             }
5005             break
5006         }
5007         incr le
5008     }
5009     if {$le <= $row} {
5010         return $row
5011     }
5012
5013     set lines {}
5014     set i 0
5015     set joinhigh 0
5016     if {[info exists linesegs($id)]} {
5017         set lines $linesegs($id)
5018         foreach li $lines {
5019             set r0 [lindex $li 0]
5020             if {$r0 > $row} {
5021                 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5022                     set joinhigh 1
5023                 }
5024                 break
5025             }
5026             incr i
5027         }
5028     }
5029     set joinlow 0
5030     if {$i > 0} {
5031         set li [lindex $lines [expr {$i-1}]]
5032         set r1 [lindex $li 1]
5033         if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5034             set joinlow 1
5035         }
5036     }
5037
5038     set x [lindex $cols [expr {$le - $row}]]
5039     set xp [lindex $cols [expr {$le - 1 - $row}]]
5040     set dir [expr {$xp - $x}]
5041     if {$joinhigh} {
5042         set ith [lindex $lines $i 2]
5043         set coords [$canv coords $ith]
5044         set ah [$canv itemcget $ith -arrow]
5045         set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5046         set x2 [lindex $cols [expr {$le + 1 - $row}]]
5047         if {$x2 ne {} && $x - $x2 == $dir} {
5048             set coords [lrange $coords 0 end-2]
5049         }
5050     } else {
5051         set coords [list [xc $le $x] [yc $le]]
5052     }
5053     if {$joinlow} {
5054         set itl [lindex $lines [expr {$i-1}] 2]
5055         set al [$canv itemcget $itl -arrow]
5056         set arrowlow [expr {$al eq "last" || $al eq "both"}]
5057     } elseif {$arrowlow} {
5058         if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5059             [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5060             set arrowlow 0
5061         }
5062     }
5063     set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5064     for {set y $le} {[incr y -1] > $row} {} {
5065         set x $xp
5066         set xp [lindex $cols [expr {$y - 1 - $row}]]
5067         set ndir [expr {$xp - $x}]
5068         if {$dir != $ndir || $xp < 0} {
5069             lappend coords [xc $y $x] [yc $y]
5070         }
5071         set dir $ndir
5072     }
5073     if {!$joinlow} {
5074         if {$xp < 0} {
5075             # join parent line to first child
5076             set ch [lindex $displayorder $row]
5077             set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5078             if {$xc < 0} {
5079                 puts "oops: drawlineseg: child $ch not on row $row"
5080             } elseif {$xc != $x} {
5081                 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5082                     set d [expr {int(0.5 * $linespc)}]
5083                     set x1 [xc $row $x]
5084                     if {$xc < $x} {
5085                         set x2 [expr {$x1 - $d}]
5086                     } else {
5087                         set x2 [expr {$x1 + $d}]
5088                     }
5089                     set y2 [yc $row]
5090                     set y1 [expr {$y2 + $d}]
5091                     lappend coords $x1 $y1 $x2 $y2
5092                 } elseif {$xc < $x - 1} {
5093                     lappend coords [xc $row [expr {$x-1}]] [yc $row]
5094                 } elseif {$xc > $x + 1} {
5095                     lappend coords [xc $row [expr {$x+1}]] [yc $row]
5096                 }
5097                 set x $xc
5098             }
5099             lappend coords [xc $row $x] [yc $row]
5100         } else {
5101             set xn [xc $row $xp]
5102             set yn [yc $row]
5103             lappend coords $xn $yn
5104         }
5105         if {!$joinhigh} {
5106             assigncolor $id
5107             set t [$canv create line $coords -width [linewidth $id] \
5108                        -fill $colormap($id) -tags lines.$id -arrow $arrow]
5109             $canv lower $t
5110             bindline $t $id
5111             set lines [linsert $lines $i [list $row $le $t]]
5112         } else {
5113             $canv coords $ith $coords
5114             if {$arrow ne $ah} {
5115                 $canv itemconf $ith -arrow $arrow
5116             }
5117             lset lines $i 0 $row
5118         }
5119     } else {
5120         set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
5121         set ndir [expr {$xo - $xp}]
5122         set clow [$canv coords $itl]
5123         if {$dir == $ndir} {
5124             set clow [lrange $clow 2 end]
5125         }
5126         set coords [concat $coords $clow]
5127         if {!$joinhigh} {
5128             lset lines [expr {$i-1}] 1 $le
5129         } else {
5130             # coalesce two pieces
5131             $canv delete $ith
5132             set b [lindex $lines [expr {$i-1}] 0]
5133             set e [lindex $lines $i 1]
5134             set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
5135         }
5136         $canv coords $itl $coords
5137         if {$arrow ne $al} {
5138             $canv itemconf $itl -arrow $arrow
5139         }
5140     }
5141
5142     set linesegs($id) $lines
5143     return $le
5144 }
5145
5146 proc drawparentlinks {id row} {
5147     global rowidlist canv colormap curview parentlist
5148     global idpos linespc
5149
5150     set rowids [lindex $rowidlist $row]
5151     set col [lsearch -exact $rowids $id]
5152     if {$col < 0} return
5153     set olds [lindex $parentlist $row]
5154     set row2 [expr {$row + 1}]
5155     set x [xc $row $col]
5156     set y [yc $row]
5157     set y2 [yc $row2]
5158     set d [expr {int(0.5 * $linespc)}]
5159     set ymid [expr {$y + $d}]
5160     set ids [lindex $rowidlist $row2]
5161     # rmx = right-most X coord used
5162     set rmx 0
5163     foreach p $olds {
5164         set i [lsearch -exact $ids $p]
5165         if {$i < 0} {
5166             puts "oops, parent $p of $id not in list"
5167             continue
5168         }
5169         set x2 [xc $row2 $i]
5170         if {$x2 > $rmx} {
5171             set rmx $x2
5172         }
5173         set j [lsearch -exact $rowids $p]
5174         if {$j < 0} {
5175             # drawlineseg will do this one for us
5176             continue
5177         }
5178         assigncolor $p
5179         # should handle duplicated parents here...
5180         set coords [list $x $y]
5181         if {$i != $col} {
5182             # if attaching to a vertical segment, draw a smaller
5183             # slant for visual distinctness
5184             if {$i == $j} {
5185                 if {$i < $col} {
5186                     lappend coords [expr {$x2 + $d}] $y $x2 $ymid
5187                 } else {
5188                     lappend coords [expr {$x2 - $d}] $y $x2 $ymid
5189                 }
5190             } elseif {$i < $col && $i < $j} {
5191                 # segment slants towards us already
5192                 lappend coords [xc $row $j] $y
5193             } else {
5194                 if {$i < $col - 1} {
5195                     lappend coords [expr {$x2 + $linespc}] $y
5196                 } elseif {$i > $col + 1} {
5197                     lappend coords [expr {$x2 - $linespc}] $y
5198                 }
5199                 lappend coords $x2 $y2
5200             }
5201         } else {
5202             lappend coords $x2 $y2
5203         }
5204         set t [$canv create line $coords -width [linewidth $p] \
5205                    -fill $colormap($p) -tags lines.$p]
5206         $canv lower $t
5207         bindline $t $p
5208     }
5209     if {$rmx > [lindex $idpos($id) 1]} {
5210         lset idpos($id) 1 $rmx
5211         redrawtags $id
5212     }
5213 }
5214
5215 proc drawlines {id} {
5216     global canv
5217
5218     $canv itemconf lines.$id -width [linewidth $id]
5219 }
5220
5221 proc drawcmittext {id row col} {
5222     global linespc canv canv2 canv3 fgcolor curview
5223     global cmitlisted commitinfo rowidlist parentlist
5224     global rowtextx idpos idtags idheads idotherrefs
5225     global linehtag linentag linedtag selectedline
5226     global canvxmax boldrows boldnamerows fgcolor
5227     global mainheadid nullid nullid2 circleitem circlecolors ctxbut
5228
5229     # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
5230     set listed $cmitlisted($curview,$id)
5231     if {$id eq $nullid} {
5232         set ofill red
5233     } elseif {$id eq $nullid2} {
5234         set ofill green
5235     } elseif {$id eq $mainheadid} {
5236         set ofill yellow
5237     } else {
5238         set ofill [lindex $circlecolors $listed]
5239     }
5240     set x [xc $row $col]
5241     set y [yc $row]
5242     set orad [expr {$linespc / 3}]
5243     if {$listed <= 2} {
5244         set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
5245                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5246                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
5247     } elseif {$listed == 3} {
5248         # triangle pointing left for left-side commits
5249         set t [$canv create polygon \
5250                    [expr {$x - $orad}] $y \
5251                    [expr {$x + $orad - 1}] [expr {$y - $orad}] \
5252                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5253                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
5254     } else {
5255         # triangle pointing right for right-side commits
5256         set t [$canv create polygon \
5257                    [expr {$x + $orad - 1}] $y \
5258                    [expr {$x - $orad}] [expr {$y - $orad}] \
5259                    [expr {$x - $orad}] [expr {$y + $orad - 1}] \
5260                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
5261     }
5262     set circleitem($row) $t
5263     $canv raise $t
5264     $canv bind $t <1> {selcanvline {} %x %y}
5265     set rmx [llength [lindex $rowidlist $row]]
5266     set olds [lindex $parentlist $row]
5267     if {$olds ne {}} {
5268         set nextids [lindex $rowidlist [expr {$row + 1}]]
5269         foreach p $olds {
5270             set i [lsearch -exact $nextids $p]
5271             if {$i > $rmx} {
5272                 set rmx $i
5273             }
5274         }
5275     }
5276     set xt [xc $row $rmx]
5277     set rowtextx($row) $xt
5278     set idpos($id) [list $x $xt $y]
5279     if {[info exists idtags($id)] || [info exists idheads($id)]
5280         || [info exists idotherrefs($id)]} {
5281         set xt [drawtags $id $x $xt $y]
5282     }
5283     set headline [lindex $commitinfo($id) 0]
5284     set name [lindex $commitinfo($id) 1]
5285     set date [lindex $commitinfo($id) 2]
5286     set date [formatdate $date]
5287     set font mainfont
5288     set nfont mainfont
5289     set isbold [ishighlighted $id]
5290     if {$isbold > 0} {
5291         lappend boldrows $row
5292         set font mainfontbold
5293         if {$isbold > 1} {
5294             lappend boldnamerows $row
5295             set nfont mainfontbold
5296         }
5297     }
5298     set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
5299                             -text $headline -font $font -tags text]
5300     $canv bind $linehtag($row) $ctxbut "rowmenu %X %Y $id"
5301     set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
5302                             -text $name -font $nfont -tags text]
5303     set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
5304                             -text $date -font mainfont -tags text]
5305     if {$selectedline == $row} {
5306         make_secsel $row
5307     }
5308     set xr [expr {$xt + [font measure $font $headline]}]
5309     if {$xr > $canvxmax} {
5310         set canvxmax $xr
5311         setcanvscroll
5312     }
5313 }
5314
5315 proc drawcmitrow {row} {
5316     global displayorder rowidlist nrows_drawn
5317     global iddrawn markingmatches
5318     global commitinfo numcommits
5319     global filehighlight fhighlights findpattern nhighlights
5320     global hlview vhighlights
5321     global highlight_related rhighlights
5322
5323     if {$row >= $numcommits} return
5324
5325     set id [lindex $displayorder $row]
5326     if {[info exists hlview] && ![info exists vhighlights($id)]} {
5327         askvhighlight $row $id
5328     }
5329     if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
5330         askfilehighlight $row $id
5331     }
5332     if {$findpattern ne {} && ![info exists nhighlights($id)]} {
5333         askfindhighlight $row $id
5334     }
5335     if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
5336         askrelhighlight $row $id
5337     }
5338     if {![info exists iddrawn($id)]} {
5339         set col [lsearch -exact [lindex $rowidlist $row] $id]
5340         if {$col < 0} {
5341             puts "oops, row $row id $id not in list"
5342             return
5343         }
5344         if {![info exists commitinfo($id)]} {
5345             getcommit $id
5346         }
5347         assigncolor $id
5348         drawcmittext $id $row $col
5349         set iddrawn($id) 1
5350         incr nrows_drawn
5351     }
5352     if {$markingmatches} {
5353         markrowmatches $row $id
5354     }
5355 }
5356
5357 proc drawcommits {row {endrow {}}} {
5358     global numcommits iddrawn displayorder curview need_redisplay
5359     global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
5360
5361     if {$row < 0} {
5362         set row 0
5363     }
5364     if {$endrow eq {}} {
5365         set endrow $row
5366     }
5367     if {$endrow >= $numcommits} {
5368         set endrow [expr {$numcommits - 1}]
5369     }
5370
5371     set rl1 [expr {$row - $downarrowlen - 3}]
5372     if {$rl1 < 0} {
5373         set rl1 0
5374     }
5375     set ro1 [expr {$row - 3}]
5376     if {$ro1 < 0} {
5377         set ro1 0
5378     }
5379     set r2 [expr {$endrow + $uparrowlen + 3}]
5380     if {$r2 > $numcommits} {
5381         set r2 $numcommits
5382     }
5383     for {set r $rl1} {$r < $r2} {incr r} {
5384         if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
5385             if {$rl1 < $r} {
5386                 layoutrows $rl1 $r
5387             }
5388             set rl1 [expr {$r + 1}]
5389         }
5390     }
5391     if {$rl1 < $r} {
5392         layoutrows $rl1 $r
5393     }
5394     optimize_rows $ro1 0 $r2
5395     if {$need_redisplay || $nrows_drawn > 2000} {
5396         clear_display
5397         drawvisible
5398     }
5399
5400     # make the lines join to already-drawn rows either side
5401     set r [expr {$row - 1}]
5402     if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
5403         set r $row
5404     }
5405     set er [expr {$endrow + 1}]
5406     if {$er >= $numcommits ||
5407         ![info exists iddrawn([lindex $displayorder $er])]} {
5408         set er $endrow
5409     }
5410     for {} {$r <= $er} {incr r} {
5411         set id [lindex $displayorder $r]
5412         set wasdrawn [info exists iddrawn($id)]
5413         drawcmitrow $r
5414         if {$r == $er} break
5415         set nextid [lindex $displayorder [expr {$r + 1}]]
5416         if {$wasdrawn && [info exists iddrawn($nextid)]} continue
5417         drawparentlinks $id $r
5418
5419         set rowids [lindex $rowidlist $r]
5420         foreach lid $rowids {
5421             if {$lid eq {}} continue
5422             if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
5423             if {$lid eq $id} {
5424                 # see if this is the first child of any of its parents
5425                 foreach p [lindex $parentlist $r] {
5426                     if {[lsearch -exact $rowids $p] < 0} {
5427                         # make this line extend up to the child
5428                         set lineend($p) [drawlineseg $p $r $er 0]
5429                     }
5430                 }
5431             } else {
5432                 set lineend($lid) [drawlineseg $lid $r $er 1]
5433             }
5434         }
5435     }
5436 }
5437
5438 proc undolayout {row} {
5439     global uparrowlen mingaplen downarrowlen
5440     global rowidlist rowisopt rowfinal need_redisplay
5441
5442     set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
5443     if {$r < 0} {
5444         set r 0
5445     }
5446     if {[llength $rowidlist] > $r} {
5447         incr r -1
5448         set rowidlist [lrange $rowidlist 0 $r]
5449         set rowfinal [lrange $rowfinal 0 $r]
5450         set rowisopt [lrange $rowisopt 0 $r]
5451         set need_redisplay 1
5452         run drawvisible
5453     }
5454 }
5455
5456 proc drawvisible {} {
5457     global canv linespc curview vrowmod selectedline targetrow targetid
5458     global need_redisplay cscroll numcommits
5459
5460     set fs [$canv yview]
5461     set ymax [lindex [$canv cget -scrollregion] 3]
5462     if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
5463     set f0 [lindex $fs 0]
5464     set f1 [lindex $fs 1]
5465     set y0 [expr {int($f0 * $ymax)}]
5466     set y1 [expr {int($f1 * $ymax)}]
5467
5468     if {[info exists targetid]} {
5469         if {[commitinview $targetid $curview]} {
5470             set r [rowofcommit $targetid]
5471             if {$r != $targetrow} {
5472                 # Fix up the scrollregion and change the scrolling position
5473                 # now that our target row has moved.
5474                 set diff [expr {($r - $targetrow) * $linespc}]
5475                 set targetrow $r
5476                 setcanvscroll
5477                 set ymax [lindex [$canv cget -scrollregion] 3]
5478                 incr y0 $diff
5479                 incr y1 $diff
5480                 set f0 [expr {$y0 / $ymax}]
5481                 set f1 [expr {$y1 / $ymax}]
5482                 allcanvs yview moveto $f0
5483                 $cscroll set $f0 $f1
5484                 set need_redisplay 1
5485             }
5486         } else {
5487             unset targetid
5488         }
5489     }
5490
5491     set row [expr {int(($y0 - 3) / $linespc) - 1}]
5492     set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
5493     if {$endrow >= $vrowmod($curview)} {
5494         update_arcrows $curview
5495     }
5496     if {$selectedline ne {} &&
5497         $row <= $selectedline && $selectedline <= $endrow} {
5498         set targetrow $selectedline
5499     } elseif {[info exists targetid]} {
5500         set targetrow [expr {int(($row + $endrow) / 2)}]
5501     }
5502     if {[info exists targetrow]} {
5503         if {$targetrow >= $numcommits} {
5504             set targetrow [expr {$numcommits - 1}]
5505         }
5506         set targetid [commitonrow $targetrow]
5507     }
5508     drawcommits $row $endrow
5509 }
5510
5511 proc clear_display {} {
5512     global iddrawn linesegs need_redisplay nrows_drawn
5513     global vhighlights fhighlights nhighlights rhighlights
5514     global linehtag linentag linedtag boldrows boldnamerows
5515
5516     allcanvs delete all
5517     catch {unset iddrawn}
5518     catch {unset linesegs}
5519     catch {unset linehtag}
5520     catch {unset linentag}
5521     catch {unset linedtag}
5522     set boldrows {}
5523     set boldnamerows {}
5524     catch {unset vhighlights}
5525     catch {unset fhighlights}
5526     catch {unset nhighlights}
5527     catch {unset rhighlights}
5528     set need_redisplay 0
5529     set nrows_drawn 0
5530 }
5531
5532 proc findcrossings {id} {
5533     global rowidlist parentlist numcommits displayorder
5534
5535     set cross {}
5536     set ccross {}
5537     foreach {s e} [rowranges $id] {
5538         if {$e >= $numcommits} {
5539             set e [expr {$numcommits - 1}]
5540         }
5541         if {$e <= $s} continue
5542         for {set row $e} {[incr row -1] >= $s} {} {
5543             set x [lsearch -exact [lindex $rowidlist $row] $id]
5544             if {$x < 0} break
5545             set olds [lindex $parentlist $row]
5546             set kid [lindex $displayorder $row]
5547             set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
5548             if {$kidx < 0} continue
5549             set nextrow [lindex $rowidlist [expr {$row + 1}]]
5550             foreach p $olds {
5551                 set px [lsearch -exact $nextrow $p]
5552                 if {$px < 0} continue
5553                 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
5554                     if {[lsearch -exact $ccross $p] >= 0} continue
5555                     if {$x == $px + ($kidx < $px? -1: 1)} {
5556                         lappend ccross $p
5557                     } elseif {[lsearch -exact $cross $p] < 0} {
5558                         lappend cross $p
5559                     }
5560                 }
5561             }
5562         }
5563     }
5564     return [concat $ccross {{}} $cross]
5565 }
5566
5567 proc assigncolor {id} {
5568     global colormap colors nextcolor
5569     global parents children children curview
5570
5571     if {[info exists colormap($id)]} return
5572     set ncolors [llength $colors]
5573     if {[info exists children($curview,$id)]} {
5574         set kids $children($curview,$id)
5575     } else {
5576         set kids {}
5577     }
5578     if {[llength $kids] == 1} {
5579         set child [lindex $kids 0]
5580         if {[info exists colormap($child)]
5581             && [llength $parents($curview,$child)] == 1} {
5582             set colormap($id) $colormap($child)
5583             return
5584         }
5585     }
5586     set badcolors {}
5587     set origbad {}
5588     foreach x [findcrossings $id] {
5589         if {$x eq {}} {
5590             # delimiter between corner crossings and other crossings
5591             if {[llength $badcolors] >= $ncolors - 1} break
5592             set origbad $badcolors
5593         }
5594         if {[info exists colormap($x)]
5595             && [lsearch -exact $badcolors $colormap($x)] < 0} {
5596             lappend badcolors $colormap($x)
5597         }
5598     }
5599     if {[llength $badcolors] >= $ncolors} {
5600         set badcolors $origbad
5601     }
5602     set origbad $badcolors
5603     if {[llength $badcolors] < $ncolors - 1} {
5604         foreach child $kids {
5605             if {[info exists colormap($child)]
5606                 && [lsearch -exact $badcolors $colormap($child)] < 0} {
5607                 lappend badcolors $colormap($child)
5608             }
5609             foreach p $parents($curview,$child) {
5610                 if {[info exists colormap($p)]
5611                     && [lsearch -exact $badcolors $colormap($p)] < 0} {
5612                     lappend badcolors $colormap($p)
5613                 }
5614             }
5615         }
5616         if {[llength $badcolors] >= $ncolors} {
5617             set badcolors $origbad
5618         }
5619     }
5620     for {set i 0} {$i <= $ncolors} {incr i} {
5621         set c [lindex $colors $nextcolor]
5622         if {[incr nextcolor] >= $ncolors} {
5623             set nextcolor 0
5624         }
5625         if {[lsearch -exact $badcolors $c]} break
5626     }
5627     set colormap($id) $c
5628 }
5629
5630 proc bindline {t id} {
5631     global canv
5632
5633     $canv bind $t <Enter> "lineenter %x %y $id"
5634     $canv bind $t <Motion> "linemotion %x %y $id"
5635     $canv bind $t <Leave> "lineleave $id"
5636     $canv bind $t <Button-1> "lineclick %x %y $id 1"
5637 }
5638
5639 proc drawtags {id x xt y1} {
5640     global idtags idheads idotherrefs mainhead
5641     global linespc lthickness
5642     global canv rowtextx curview fgcolor bgcolor ctxbut
5643
5644     set marks {}
5645     set ntags 0
5646     set nheads 0
5647     if {[info exists idtags($id)]} {
5648         set marks $idtags($id)
5649         set ntags [llength $marks]
5650     }
5651     if {[info exists idheads($id)]} {
5652         set marks [concat $marks $idheads($id)]
5653         set nheads [llength $idheads($id)]
5654     }
5655     if {[info exists idotherrefs($id)]} {
5656         set marks [concat $marks $idotherrefs($id)]
5657     }
5658     if {$marks eq {}} {
5659         return $xt
5660     }
5661
5662     set delta [expr {int(0.5 * ($linespc - $lthickness))}]
5663     set yt [expr {$y1 - 0.5 * $linespc}]
5664     set yb [expr {$yt + $linespc - 1}]
5665     set xvals {}
5666     set wvals {}
5667     set i -1
5668     foreach tag $marks {
5669         incr i
5670         if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
5671             set wid [font measure mainfontbold $tag]
5672         } else {
5673             set wid [font measure mainfont $tag]
5674         }
5675         lappend xvals $xt
5676         lappend wvals $wid
5677         set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
5678     }
5679     set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
5680                -width $lthickness -fill black -tags tag.$id]
5681     $canv lower $t
5682     foreach tag $marks x $xvals wid $wvals {
5683         set xl [expr {$x + $delta}]
5684         set xr [expr {$x + $delta + $wid + $lthickness}]
5685         set font mainfont
5686         if {[incr ntags -1] >= 0} {
5687             # draw a tag
5688             set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
5689                        $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
5690                        -width 1 -outline black -fill yellow -tags tag.$id]
5691             $canv bind $t <1> [list showtag $tag 1]
5692             set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
5693         } else {
5694             # draw a head or other ref
5695             if {[incr nheads -1] >= 0} {
5696                 set col green
5697                 if {$tag eq $mainhead} {
5698                     set font mainfontbold
5699                 }
5700             } else {
5701                 set col "#ddddff"
5702             }
5703             set xl [expr {$xl - $delta/2}]
5704             $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
5705                 -width 1 -outline black -fill $col -tags tag.$id
5706             if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
5707                 set rwid [font measure mainfont $remoteprefix]
5708                 set xi [expr {$x + 1}]
5709                 set yti [expr {$yt + 1}]
5710                 set xri [expr {$x + $rwid}]
5711                 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
5712                         -width 0 -fill "#ffddaa" -tags tag.$id
5713             }
5714         }
5715         set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
5716                    -font $font -tags [list tag.$id text]]
5717         if {$ntags >= 0} {
5718             $canv bind $t <1> [list showtag $tag 1]
5719         } elseif {$nheads >= 0} {
5720             $canv bind $t $ctxbut [list headmenu %X %Y $id $tag]
5721         }
5722     }
5723     return $xt
5724 }
5725
5726 proc xcoord {i level ln} {
5727     global canvx0 xspc1 xspc2
5728
5729     set x [expr {$canvx0 + $i * $xspc1($ln)}]
5730     if {$i > 0 && $i == $level} {
5731         set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
5732     } elseif {$i > $level} {
5733         set x [expr {$x + $xspc2 - $xspc1($ln)}]
5734     }
5735     return $x
5736 }
5737
5738 proc show_status {msg} {
5739     global canv fgcolor
5740
5741     clear_display
5742     $canv create text 3 3 -anchor nw -text $msg -font mainfont \
5743         -tags text -fill $fgcolor
5744 }
5745
5746 # Don't change the text pane cursor if it is currently the hand cursor,
5747 # showing that we are over a sha1 ID link.
5748 proc settextcursor {c} {
5749     global ctext curtextcursor
5750
5751     if {[$ctext cget -cursor] == $curtextcursor} {
5752         $ctext config -cursor $c
5753     }
5754     set curtextcursor $c
5755 }
5756
5757 proc nowbusy {what {name {}}} {
5758     global isbusy busyname statusw
5759
5760     if {[array names isbusy] eq {}} {
5761         . config -cursor watch
5762         settextcursor watch
5763     }
5764     set isbusy($what) 1
5765     set busyname($what) $name
5766     if {$name ne {}} {
5767         $statusw conf -text $name
5768     }
5769 }
5770
5771 proc notbusy {what} {
5772     global isbusy maincursor textcursor busyname statusw
5773
5774     catch {
5775         unset isbusy($what)
5776         if {$busyname($what) ne {} &&
5777             [$statusw cget -text] eq $busyname($what)} {
5778             $statusw conf -text {}
5779         }
5780     }
5781     if {[array names isbusy] eq {}} {
5782         . config -cursor $maincursor
5783         settextcursor $textcursor
5784     }
5785 }
5786
5787 proc findmatches {f} {
5788     global findtype findstring
5789     if {$findtype == [mc "Regexp"]} {
5790         set matches [regexp -indices -all -inline $findstring $f]
5791     } else {
5792         set fs $findstring
5793         if {$findtype == [mc "IgnCase"]} {
5794             set f [string tolower $f]
5795             set fs [string tolower $fs]
5796         }
5797         set matches {}
5798         set i 0
5799         set l [string length $fs]
5800         while {[set j [string first $fs $f $i]] >= 0} {
5801             lappend matches [list $j [expr {$j+$l-1}]]
5802             set i [expr {$j + $l}]
5803         }
5804     }
5805     return $matches
5806 }
5807
5808 proc dofind {{dirn 1} {wrap 1}} {
5809     global findstring findstartline findcurline selectedline numcommits
5810     global gdttype filehighlight fh_serial find_dirn findallowwrap
5811
5812     if {[info exists find_dirn]} {
5813         if {$find_dirn == $dirn} return
5814         stopfinding
5815     }
5816     focus .
5817     if {$findstring eq {} || $numcommits == 0} return
5818     if {$selectedline eq {}} {
5819         set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
5820     } else {
5821         set findstartline $selectedline
5822     }
5823     set findcurline $findstartline
5824     nowbusy finding [mc "Searching"]
5825     if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
5826         after cancel do_file_hl $fh_serial
5827         do_file_hl $fh_serial
5828     }
5829     set find_dirn $dirn
5830     set findallowwrap $wrap
5831     run findmore
5832 }
5833
5834 proc stopfinding {} {
5835     global find_dirn findcurline fprogcoord
5836
5837     if {[info exists find_dirn]} {
5838         unset find_dirn
5839         unset findcurline
5840         notbusy finding
5841         set fprogcoord 0
5842         adjustprogress
5843     }
5844     stopblaming
5845 }
5846
5847 proc findmore {} {
5848     global commitdata commitinfo numcommits findpattern findloc
5849     global findstartline findcurline findallowwrap
5850     global find_dirn gdttype fhighlights fprogcoord
5851     global curview varcorder vrownum varccommits vrowmod
5852
5853     if {![info exists find_dirn]} {
5854         return 0
5855     }
5856     set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
5857     set l $findcurline
5858     set moretodo 0
5859     if {$find_dirn > 0} {
5860         incr l
5861         if {$l >= $numcommits} {
5862             set l 0
5863         }
5864         if {$l <= $findstartline} {
5865             set lim [expr {$findstartline + 1}]
5866         } else {
5867             set lim $numcommits
5868             set moretodo $findallowwrap
5869         }
5870     } else {
5871         if {$l == 0} {
5872             set l $numcommits
5873         }
5874         incr l -1
5875         if {$l >= $findstartline} {
5876             set lim [expr {$findstartline - 1}]
5877         } else {
5878             set lim -1
5879             set moretodo $findallowwrap
5880         }
5881     }
5882     set n [expr {($lim - $l) * $find_dirn}]
5883     if {$n > 500} {
5884         set n 500
5885         set moretodo 1
5886     }
5887     if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
5888         update_arcrows $curview
5889     }
5890     set found 0
5891     set domore 1
5892     set ai [bsearch $vrownum($curview) $l]
5893     set a [lindex $varcorder($curview) $ai]
5894     set arow [lindex $vrownum($curview) $ai]
5895     set ids [lindex $varccommits($curview,$a)]
5896     set arowend [expr {$arow + [llength $ids]}]
5897     if {$gdttype eq [mc "containing:"]} {
5898         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
5899             if {$l < $arow || $l >= $arowend} {
5900                 incr ai $find_dirn
5901                 set a [lindex $varcorder($curview) $ai]
5902                 set arow [lindex $vrownum($curview) $ai]
5903                 set ids [lindex $varccommits($curview,$a)]
5904                 set arowend [expr {$arow + [llength $ids]}]
5905             }
5906             set id [lindex $ids [expr {$l - $arow}]]
5907             # shouldn't happen unless git log doesn't give all the commits...
5908             if {![info exists commitdata($id)] ||
5909                 ![doesmatch $commitdata($id)]} {
5910                 continue
5911             }
5912             if {![info exists commitinfo($id)]} {
5913                 getcommit $id
5914             }
5915             set info $commitinfo($id)
5916             foreach f $info ty $fldtypes {
5917                 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
5918                     [doesmatch $f]} {
5919                     set found 1
5920                     break
5921                 }
5922             }
5923             if {$found} break
5924         }
5925     } else {
5926         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
5927             if {$l < $arow || $l >= $arowend} {
5928                 incr ai $find_dirn
5929                 set a [lindex $varcorder($curview) $ai]
5930                 set arow [lindex $vrownum($curview) $ai]
5931                 set ids [lindex $varccommits($curview,$a)]
5932                 set arowend [expr {$arow + [llength $ids]}]
5933             }
5934             set id [lindex $ids [expr {$l - $arow}]]
5935             if {![info exists fhighlights($id)]} {
5936                 # this sets fhighlights($id) to -1
5937                 askfilehighlight $l $id
5938             }
5939             if {$fhighlights($id) > 0} {
5940                 set found $domore
5941                 break
5942             }
5943             if {$fhighlights($id) < 0} {
5944                 if {$domore} {
5945                     set domore 0
5946                     set findcurline [expr {$l - $find_dirn}]
5947                 }
5948             }
5949         }
5950     }
5951     if {$found || ($domore && !$moretodo)} {
5952         unset findcurline
5953         unset find_dirn
5954         notbusy finding
5955         set fprogcoord 0
5956         adjustprogress
5957         if {$found} {
5958             findselectline $l
5959         } else {
5960             bell
5961         }
5962         return 0
5963     }
5964     if {!$domore} {
5965         flushhighlights
5966     } else {
5967         set findcurline [expr {$l - $find_dirn}]
5968     }
5969     set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
5970     if {$n < 0} {
5971         incr n $numcommits
5972     }
5973     set fprogcoord [expr {$n * 1.0 / $numcommits}]
5974     adjustprogress
5975     return $domore
5976 }
5977
5978 proc findselectline {l} {
5979     global findloc commentend ctext findcurline markingmatches gdttype
5980
5981     set markingmatches 1
5982     set findcurline $l
5983     selectline $l 1
5984     if {$findloc == [mc "All fields"] || $findloc == [mc "Comments"]} {
5985         # highlight the matches in the comments
5986         set f [$ctext get 1.0 $commentend]
5987         set matches [findmatches $f]
5988         foreach match $matches {
5989             set start [lindex $match 0]
5990             set end [expr {[lindex $match 1] + 1}]
5991             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
5992         }
5993     }
5994     drawvisible
5995 }
5996
5997 # mark the bits of a headline or author that match a find string
5998 proc markmatches {canv l str tag matches font row} {
5999     global selectedline
6000
6001     set bbox [$canv bbox $tag]
6002     set x0 [lindex $bbox 0]
6003     set y0 [lindex $bbox 1]
6004     set y1 [lindex $bbox 3]
6005     foreach match $matches {
6006         set start [lindex $match 0]
6007         set end [lindex $match 1]
6008         if {$start > $end} continue
6009         set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6010         set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6011         set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6012                    [expr {$x0+$xlen+2}] $y1 \
6013                    -outline {} -tags [list match$l matches] -fill yellow]
6014         $canv lower $t
6015         if {$row == $selectedline} {
6016             $canv raise $t secsel
6017         }
6018     }
6019 }
6020
6021 proc unmarkmatches {} {
6022     global markingmatches
6023
6024     allcanvs delete matches
6025     set markingmatches 0
6026     stopfinding
6027 }
6028
6029 proc selcanvline {w x y} {
6030     global canv canvy0 ctext linespc
6031     global rowtextx
6032     set ymax [lindex [$canv cget -scrollregion] 3]
6033     if {$ymax == {}} return
6034     set yfrac [lindex [$canv yview] 0]
6035     set y [expr {$y + $yfrac * $ymax}]
6036     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6037     if {$l < 0} {
6038         set l 0
6039     }
6040     if {$w eq $canv} {
6041         set xmax [lindex [$canv cget -scrollregion] 2]
6042         set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6043         if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
6044     }
6045     unmarkmatches
6046     selectline $l 1
6047 }
6048
6049 proc commit_descriptor {p} {
6050     global commitinfo
6051     if {![info exists commitinfo($p)]} {
6052         getcommit $p
6053     }
6054     set l "..."
6055     if {[llength $commitinfo($p)] > 1} {
6056         set l [lindex $commitinfo($p) 0]
6057     }
6058     return "$p ($l)\n"
6059 }
6060
6061 # append some text to the ctext widget, and make any SHA1 ID
6062 # that we know about be a clickable link.
6063 proc appendwithlinks {text tags} {
6064     global ctext linknum curview
6065
6066     set start [$ctext index "end - 1c"]
6067     $ctext insert end $text $tags
6068     set links [regexp -indices -all -inline {\m[0-9a-f]{6,40}\M} $text]
6069     foreach l $links {
6070         set s [lindex $l 0]
6071         set e [lindex $l 1]
6072         set linkid [string range $text $s $e]
6073         incr e
6074         $ctext tag delete link$linknum
6075         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
6076         setlink $linkid link$linknum
6077         incr linknum
6078     }
6079 }
6080
6081 proc setlink {id lk} {
6082     global curview ctext pendinglinks
6083
6084     set known 0
6085     if {[string length $id] < 40} {
6086         set matches [longid $id]
6087         if {[llength $matches] > 0} {
6088             if {[llength $matches] > 1} return
6089             set known 1
6090             set id [lindex $matches 0]
6091         }
6092     } else {
6093         set known [commitinview $id $curview]
6094     }
6095     if {$known} {
6096         $ctext tag conf $lk -foreground blue -underline 1
6097         $ctext tag bind $lk <1> [list selbyid $id]
6098         $ctext tag bind $lk <Enter> {linkcursor %W 1}
6099         $ctext tag bind $lk <Leave> {linkcursor %W -1}
6100     } else {
6101         lappend pendinglinks($id) $lk
6102         interestedin $id {makelink %P}
6103     }
6104 }
6105
6106 proc makelink {id} {
6107     global pendinglinks
6108
6109     if {![info exists pendinglinks($id)]} return
6110     foreach lk $pendinglinks($id) {
6111         setlink $id $lk
6112     }
6113     unset pendinglinks($id)
6114 }
6115
6116 proc linkcursor {w inc} {
6117     global linkentercount curtextcursor
6118
6119     if {[incr linkentercount $inc] > 0} {
6120         $w configure -cursor hand2
6121     } else {
6122         $w configure -cursor $curtextcursor
6123         if {$linkentercount < 0} {
6124             set linkentercount 0
6125         }
6126     }
6127 }
6128
6129 proc viewnextline {dir} {
6130     global canv linespc
6131
6132     $canv delete hover
6133     set ymax [lindex [$canv cget -scrollregion] 3]
6134     set wnow [$canv yview]
6135     set wtop [expr {[lindex $wnow 0] * $ymax}]
6136     set newtop [expr {$wtop + $dir * $linespc}]
6137     if {$newtop < 0} {
6138         set newtop 0
6139     } elseif {$newtop > $ymax} {
6140         set newtop $ymax
6141     }
6142     allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6143 }
6144
6145 # add a list of tag or branch names at position pos
6146 # returns the number of names inserted
6147 proc appendrefs {pos ids var} {
6148     global ctext linknum curview $var maxrefs
6149
6150     if {[catch {$ctext index $pos}]} {
6151         return 0
6152     }
6153     $ctext conf -state normal
6154     $ctext delete $pos "$pos lineend"
6155     set tags {}
6156     foreach id $ids {
6157         foreach tag [set $var\($id\)] {
6158             lappend tags [list $tag $id]
6159         }
6160     }
6161     if {[llength $tags] > $maxrefs} {
6162         $ctext insert $pos "many ([llength $tags])"
6163     } else {
6164         set tags [lsort -index 0 -decreasing $tags]
6165         set sep {}
6166         foreach ti $tags {
6167             set id [lindex $ti 1]
6168             set lk link$linknum
6169             incr linknum
6170             $ctext tag delete $lk
6171             $ctext insert $pos $sep
6172             $ctext insert $pos [lindex $ti 0] $lk
6173             setlink $id $lk
6174             set sep ", "
6175         }
6176     }
6177     $ctext conf -state disabled
6178     return [llength $tags]
6179 }
6180
6181 # called when we have finished computing the nearby tags
6182 proc dispneartags {delay} {
6183     global selectedline currentid showneartags tagphase
6184
6185     if {$selectedline eq {} || !$showneartags} return
6186     after cancel dispnexttag
6187     if {$delay} {
6188         after 200 dispnexttag
6189         set tagphase -1
6190     } else {
6191         after idle dispnexttag
6192         set tagphase 0
6193     }
6194 }
6195
6196 proc dispnexttag {} {
6197     global selectedline currentid showneartags tagphase ctext
6198
6199     if {$selectedline eq {} || !$showneartags} return
6200     switch -- $tagphase {
6201         0 {
6202             set dtags [desctags $currentid]
6203             if {$dtags ne {}} {
6204                 appendrefs precedes $dtags idtags
6205             }
6206         }
6207         1 {
6208             set atags [anctags $currentid]
6209             if {$atags ne {}} {
6210                 appendrefs follows $atags idtags
6211             }
6212         }
6213         2 {
6214             set dheads [descheads $currentid]
6215             if {$dheads ne {}} {
6216                 if {[appendrefs branch $dheads idheads] > 1
6217                     && [$ctext get "branch -3c"] eq "h"} {
6218                     # turn "Branch" into "Branches"
6219                     $ctext conf -state normal
6220                     $ctext insert "branch -2c" "es"
6221                     $ctext conf -state disabled
6222                 }
6223             }
6224         }
6225     }
6226     if {[incr tagphase] <= 2} {
6227         after idle dispnexttag
6228     }
6229 }
6230
6231 proc make_secsel {l} {
6232     global linehtag linentag linedtag canv canv2 canv3
6233
6234     if {![info exists linehtag($l)]} return
6235     $canv delete secsel
6236     set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
6237                -tags secsel -fill [$canv cget -selectbackground]]
6238     $canv lower $t
6239     $canv2 delete secsel
6240     set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
6241                -tags secsel -fill [$canv2 cget -selectbackground]]
6242     $canv2 lower $t
6243     $canv3 delete secsel
6244     set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
6245                -tags secsel -fill [$canv3 cget -selectbackground]]
6246     $canv3 lower $t
6247 }
6248
6249 proc selectline {l isnew {desired_loc {}}} {
6250     global canv ctext commitinfo selectedline
6251     global canvy0 linespc parents children curview
6252     global currentid sha1entry
6253     global commentend idtags linknum
6254     global mergemax numcommits pending_select
6255     global cmitmode showneartags allcommits
6256     global targetrow targetid lastscrollrows
6257     global autoselect jump_to_here
6258
6259     catch {unset pending_select}
6260     $canv delete hover
6261     normalline
6262     unsel_reflist
6263     stopfinding
6264     if {$l < 0 || $l >= $numcommits} return
6265     set id [commitonrow $l]
6266     set targetid $id
6267     set targetrow $l
6268     set selectedline $l
6269     set currentid $id
6270     if {$lastscrollrows < $numcommits} {
6271         setcanvscroll
6272     }
6273
6274     set y [expr {$canvy0 + $l * $linespc}]
6275     set ymax [lindex [$canv cget -scrollregion] 3]
6276     set ytop [expr {$y - $linespc - 1}]
6277     set ybot [expr {$y + $linespc + 1}]
6278     set wnow [$canv yview]
6279     set wtop [expr {[lindex $wnow 0] * $ymax}]
6280     set wbot [expr {[lindex $wnow 1] * $ymax}]
6281     set wh [expr {$wbot - $wtop}]
6282     set newtop $wtop
6283     if {$ytop < $wtop} {
6284         if {$ybot < $wtop} {
6285             set newtop [expr {$y - $wh / 2.0}]
6286         } else {
6287             set newtop $ytop
6288             if {$newtop > $wtop - $linespc} {
6289                 set newtop [expr {$wtop - $linespc}]
6290             }
6291         }
6292     } elseif {$ybot > $wbot} {
6293         if {$ytop > $wbot} {
6294             set newtop [expr {$y - $wh / 2.0}]
6295         } else {
6296             set newtop [expr {$ybot - $wh}]
6297             if {$newtop < $wtop + $linespc} {
6298                 set newtop [expr {$wtop + $linespc}]
6299             }
6300         }
6301     }
6302     if {$newtop != $wtop} {
6303         if {$newtop < 0} {
6304             set newtop 0
6305         }
6306         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6307         drawvisible
6308     }
6309
6310     make_secsel $l
6311
6312     if {$isnew} {
6313         addtohistory [list selbyid $id]
6314     }
6315
6316     $sha1entry delete 0 end
6317     $sha1entry insert 0 $id
6318     if {$autoselect} {
6319         $sha1entry selection from 0
6320         $sha1entry selection to end
6321     }
6322     rhighlight_sel $id
6323
6324     $ctext conf -state normal
6325     clear_ctext
6326     set linknum 0
6327     if {![info exists commitinfo($id)]} {
6328         getcommit $id
6329     }
6330     set info $commitinfo($id)
6331     set date [formatdate [lindex $info 2]]
6332     $ctext insert end "[mc "Author"]: [lindex $info 1]  $date\n"
6333     set date [formatdate [lindex $info 4]]
6334     $ctext insert end "[mc "Committer"]: [lindex $info 3]  $date\n"
6335     if {[info exists idtags($id)]} {
6336         $ctext insert end [mc "Tags:"]
6337         foreach tag $idtags($id) {
6338             $ctext insert end " $tag"
6339         }
6340         $ctext insert end "\n"
6341     }
6342
6343     set headers {}
6344     set olds $parents($curview,$id)
6345     if {[llength $olds] > 1} {
6346         set np 0
6347         foreach p $olds {
6348             if {$np >= $mergemax} {
6349                 set tag mmax
6350             } else {
6351                 set tag m$np
6352             }
6353             $ctext insert end "[mc "Parent"]: " $tag
6354             appendwithlinks [commit_descriptor $p] {}
6355             incr np
6356         }
6357     } else {
6358         foreach p $olds {
6359             append headers "[mc "Parent"]: [commit_descriptor $p]"
6360         }
6361     }
6362
6363     foreach c $children($curview,$id) {
6364         append headers "[mc "Child"]:  [commit_descriptor $c]"
6365     }
6366
6367     # make anything that looks like a SHA1 ID be a clickable link
6368     appendwithlinks $headers {}
6369     if {$showneartags} {
6370         if {![info exists allcommits]} {
6371             getallcommits
6372         }
6373         $ctext insert end "[mc "Branch"]: "
6374         $ctext mark set branch "end -1c"
6375         $ctext mark gravity branch left
6376         $ctext insert end "\n[mc "Follows"]: "
6377         $ctext mark set follows "end -1c"
6378         $ctext mark gravity follows left
6379         $ctext insert end "\n[mc "Precedes"]: "
6380         $ctext mark set precedes "end -1c"
6381         $ctext mark gravity precedes left
6382         $ctext insert end "\n"
6383         dispneartags 1
6384     }
6385     $ctext insert end "\n"
6386     set comment [lindex $info 5]
6387     if {[string first "\r" $comment] >= 0} {
6388         set comment [string map {"\r" "\n    "} $comment]
6389     }
6390     appendwithlinks $comment {comment}
6391
6392     $ctext tag remove found 1.0 end
6393     $ctext conf -state disabled
6394     set commentend [$ctext index "end - 1c"]
6395
6396     set jump_to_here $desired_loc
6397     init_flist [mc "Comments"]
6398     if {$cmitmode eq "tree"} {
6399         gettree $id
6400     } elseif {[llength $olds] <= 1} {
6401         startdiff $id
6402     } else {
6403         mergediff $id
6404     }
6405 }
6406
6407 proc selfirstline {} {
6408     unmarkmatches
6409     selectline 0 1
6410 }
6411
6412 proc sellastline {} {
6413     global numcommits
6414     unmarkmatches
6415     set l [expr {$numcommits - 1}]
6416     selectline $l 1
6417 }
6418
6419 proc selnextline {dir} {
6420     global selectedline
6421     focus .
6422     if {$selectedline eq {}} return
6423     set l [expr {$selectedline + $dir}]
6424     unmarkmatches
6425     selectline $l 1
6426 }
6427
6428 proc selnextpage {dir} {
6429     global canv linespc selectedline numcommits
6430
6431     set lpp [expr {([winfo height $canv] - 2) / $linespc}]
6432     if {$lpp < 1} {
6433         set lpp 1
6434     }
6435     allcanvs yview scroll [expr {$dir * $lpp}] units
6436     drawvisible
6437     if {$selectedline eq {}} return
6438     set l [expr {$selectedline + $dir * $lpp}]
6439     if {$l < 0} {
6440         set l 0
6441     } elseif {$l >= $numcommits} {
6442         set l [expr $numcommits - 1]
6443     }
6444     unmarkmatches
6445     selectline $l 1
6446 }
6447
6448 proc unselectline {} {
6449     global selectedline currentid
6450
6451     set selectedline {}
6452     catch {unset currentid}
6453     allcanvs delete secsel
6454     rhighlight_none
6455 }
6456
6457 proc reselectline {} {
6458     global selectedline
6459
6460     if {$selectedline ne {}} {
6461         selectline $selectedline 0
6462     }
6463 }
6464
6465 proc addtohistory {cmd} {
6466     global history historyindex curview
6467
6468     set elt [list $curview $cmd]
6469     if {$historyindex > 0
6470         && [lindex $history [expr {$historyindex - 1}]] == $elt} {
6471         return
6472     }
6473
6474     if {$historyindex < [llength $history]} {
6475         set history [lreplace $history $historyindex end $elt]
6476     } else {
6477         lappend history $elt
6478     }
6479     incr historyindex
6480     if {$historyindex > 1} {
6481         .tf.bar.leftbut conf -state normal
6482     } else {
6483         .tf.bar.leftbut conf -state disabled
6484     }
6485     .tf.bar.rightbut conf -state disabled
6486 }
6487
6488 proc godo {elt} {
6489     global curview
6490
6491     set view [lindex $elt 0]
6492     set cmd [lindex $elt 1]
6493     if {$curview != $view} {
6494         showview $view
6495     }
6496     eval $cmd
6497 }
6498
6499 proc goback {} {
6500     global history historyindex
6501     focus .
6502
6503     if {$historyindex > 1} {
6504         incr historyindex -1
6505         godo [lindex $history [expr {$historyindex - 1}]]
6506         .tf.bar.rightbut conf -state normal
6507     }
6508     if {$historyindex <= 1} {
6509         .tf.bar.leftbut conf -state disabled
6510     }
6511 }
6512
6513 proc goforw {} {
6514     global history historyindex
6515     focus .
6516
6517     if {$historyindex < [llength $history]} {
6518         set cmd [lindex $history $historyindex]
6519         incr historyindex
6520         godo $cmd
6521         .tf.bar.leftbut conf -state normal
6522     }
6523     if {$historyindex >= [llength $history]} {
6524         .tf.bar.rightbut conf -state disabled
6525     }
6526 }
6527
6528 proc gettree {id} {
6529     global treefilelist treeidlist diffids diffmergeid treepending
6530     global nullid nullid2
6531
6532     set diffids $id
6533     catch {unset diffmergeid}
6534     if {![info exists treefilelist($id)]} {
6535         if {![info exists treepending]} {
6536             if {$id eq $nullid} {
6537                 set cmd [list | git ls-files]
6538             } elseif {$id eq $nullid2} {
6539                 set cmd [list | git ls-files --stage -t]
6540             } else {
6541                 set cmd [list | git ls-tree -r $id]
6542             }
6543             if {[catch {set gtf [open $cmd r]}]} {
6544                 return
6545             }
6546             set treepending $id
6547             set treefilelist($id) {}
6548             set treeidlist($id) {}
6549             fconfigure $gtf -blocking 0 -encoding binary
6550             filerun $gtf [list gettreeline $gtf $id]
6551         }
6552     } else {
6553         setfilelist $id
6554     }
6555 }
6556
6557 proc gettreeline {gtf id} {
6558     global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
6559
6560     set nl 0
6561     while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
6562         if {$diffids eq $nullid} {
6563             set fname $line
6564         } else {
6565             set i [string first "\t" $line]
6566             if {$i < 0} continue
6567             set fname [string range $line [expr {$i+1}] end]
6568             set line [string range $line 0 [expr {$i-1}]]
6569             if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
6570             set sha1 [lindex $line 2]
6571             lappend treeidlist($id) $sha1
6572         }
6573         if {[string index $fname 0] eq "\""} {
6574             set fname [lindex $fname 0]
6575         }
6576         set fname [encoding convertfrom $fname]
6577         lappend treefilelist($id) $fname
6578     }
6579     if {![eof $gtf]} {
6580         return [expr {$nl >= 1000? 2: 1}]
6581     }
6582     close $gtf
6583     unset treepending
6584     if {$cmitmode ne "tree"} {
6585         if {![info exists diffmergeid]} {
6586             gettreediffs $diffids
6587         }
6588     } elseif {$id ne $diffids} {
6589         gettree $diffids
6590     } else {
6591         setfilelist $id
6592     }
6593     return 0
6594 }
6595
6596 proc showfile {f} {
6597     global treefilelist treeidlist diffids nullid nullid2
6598     global ctext_file_names ctext_file_lines
6599     global ctext commentend
6600
6601     set i [lsearch -exact $treefilelist($diffids) $f]
6602     if {$i < 0} {
6603         puts "oops, $f not in list for id $diffids"
6604         return
6605     }
6606     if {$diffids eq $nullid} {
6607         if {[catch {set bf [open $f r]} err]} {
6608             puts "oops, can't read $f: $err"
6609             return
6610         }
6611     } else {
6612         set blob [lindex $treeidlist($diffids) $i]
6613         if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
6614             puts "oops, error reading blob $blob: $err"
6615             return
6616         }
6617     }
6618     fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
6619     filerun $bf [list getblobline $bf $diffids]
6620     $ctext config -state normal
6621     clear_ctext $commentend
6622     lappend ctext_file_names $f
6623     lappend ctext_file_lines [lindex [split $commentend "."] 0]
6624     $ctext insert end "\n"
6625     $ctext insert end "$f\n" filesep
6626     $ctext config -state disabled
6627     $ctext yview $commentend
6628     settabs 0
6629 }
6630
6631 proc getblobline {bf id} {
6632     global diffids cmitmode ctext
6633
6634     if {$id ne $diffids || $cmitmode ne "tree"} {
6635         catch {close $bf}
6636         return 0
6637     }
6638     $ctext config -state normal
6639     set nl 0
6640     while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
6641         $ctext insert end "$line\n"
6642     }
6643     if {[eof $bf]} {
6644         global jump_to_here ctext_file_names commentend
6645
6646         # delete last newline
6647         $ctext delete "end - 2c" "end - 1c"
6648         close $bf
6649         if {$jump_to_here ne {} &&
6650             [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
6651             set lnum [expr {[lindex $jump_to_here 1] +
6652                             [lindex [split $commentend .] 0]}]
6653             mark_ctext_line $lnum
6654         }
6655         return 0
6656     }
6657     $ctext config -state disabled
6658     return [expr {$nl >= 1000? 2: 1}]
6659 }
6660
6661 proc mark_ctext_line {lnum} {
6662     global ctext markbgcolor
6663
6664     $ctext tag delete omark
6665     $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
6666     $ctext tag conf omark -background $markbgcolor
6667     $ctext see $lnum.0
6668 }
6669
6670 proc mergediff {id} {
6671     global diffmergeid
6672     global diffids treediffs
6673     global parents curview
6674
6675     set diffmergeid $id
6676     set diffids $id
6677     set treediffs($id) {}
6678     set np [llength $parents($curview,$id)]
6679     settabs $np
6680     getblobdiffs $id
6681 }
6682
6683 proc startdiff {ids} {
6684     global treediffs diffids treepending diffmergeid nullid nullid2
6685
6686     settabs 1
6687     set diffids $ids
6688     catch {unset diffmergeid}
6689     if {![info exists treediffs($ids)] ||
6690         [lsearch -exact $ids $nullid] >= 0 ||
6691         [lsearch -exact $ids $nullid2] >= 0} {
6692         if {![info exists treepending]} {
6693             gettreediffs $ids
6694         }
6695     } else {
6696         addtocflist $ids
6697     }
6698 }
6699
6700 proc path_filter {filter name} {
6701     foreach p $filter {
6702         set l [string length $p]
6703         if {[string index $p end] eq "/"} {
6704             if {[string compare -length $l $p $name] == 0} {
6705                 return 1
6706             }
6707         } else {
6708             if {[string compare -length $l $p $name] == 0 &&
6709                 ([string length $name] == $l ||
6710                  [string index $name $l] eq "/")} {
6711                 return 1
6712             }
6713         }
6714     }
6715     return 0
6716 }
6717
6718 proc addtocflist {ids} {
6719     global treediffs
6720
6721     add_flist $treediffs($ids)
6722     getblobdiffs $ids
6723 }
6724
6725 proc diffcmd {ids flags} {
6726     global nullid nullid2
6727
6728     set i [lsearch -exact $ids $nullid]
6729     set j [lsearch -exact $ids $nullid2]
6730     if {$i >= 0} {
6731         if {[llength $ids] > 1 && $j < 0} {
6732             # comparing working directory with some specific revision
6733             set cmd [concat | git diff-index $flags]
6734             if {$i == 0} {
6735                 lappend cmd -R [lindex $ids 1]
6736             } else {
6737                 lappend cmd [lindex $ids 0]
6738             }
6739         } else {
6740             # comparing working directory with index
6741             set cmd [concat | git diff-files $flags]
6742             if {$j == 1} {
6743                 lappend cmd -R
6744             }
6745         }
6746     } elseif {$j >= 0} {
6747         set cmd [concat | git diff-index --cached $flags]
6748         if {[llength $ids] > 1} {
6749             # comparing index with specific revision
6750             if {$i == 0} {
6751                 lappend cmd -R [lindex $ids 1]
6752             } else {
6753                 lappend cmd [lindex $ids 0]
6754             }
6755         } else {
6756             # comparing index with HEAD
6757             lappend cmd HEAD
6758         }
6759     } else {
6760         set cmd [concat | git diff-tree -r $flags $ids]
6761     }
6762     return $cmd
6763 }
6764
6765 proc gettreediffs {ids} {
6766     global treediff treepending
6767
6768     if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
6769
6770     set treepending $ids
6771     set treediff {}
6772     fconfigure $gdtf -blocking 0 -encoding binary
6773     filerun $gdtf [list gettreediffline $gdtf $ids]
6774 }
6775
6776 proc gettreediffline {gdtf ids} {
6777     global treediff treediffs treepending diffids diffmergeid
6778     global cmitmode vfilelimit curview limitdiffs perfile_attrs
6779
6780     set nr 0
6781     set sublist {}
6782     set max 1000
6783     if {$perfile_attrs} {
6784         # cache_gitattr is slow, and even slower on win32 where we
6785         # have to invoke it for only about 30 paths at a time
6786         set max 500
6787         if {[tk windowingsystem] == "win32"} {
6788             set max 120
6789         }
6790     }
6791     while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
6792         set i [string first "\t" $line]
6793         if {$i >= 0} {
6794             set file [string range $line [expr {$i+1}] end]
6795             if {[string index $file 0] eq "\""} {
6796                 set file [lindex $file 0]
6797             }
6798             set file [encoding convertfrom $file]
6799             lappend treediff $file
6800             lappend sublist $file
6801         }
6802     }
6803     if {$perfile_attrs} {
6804         cache_gitattr encoding $sublist
6805     }
6806     if {![eof $gdtf]} {
6807         return [expr {$nr >= $max? 2: 1}]
6808     }
6809     close $gdtf
6810     if {$limitdiffs && $vfilelimit($curview) ne {}} {
6811         set flist {}
6812         foreach f $treediff {
6813             if {[path_filter $vfilelimit($curview) $f]} {
6814                 lappend flist $f
6815             }
6816         }
6817         set treediffs($ids) $flist
6818     } else {
6819         set treediffs($ids) $treediff
6820     }
6821     unset treepending
6822     if {$cmitmode eq "tree"} {
6823         gettree $diffids
6824     } elseif {$ids != $diffids} {
6825         if {![info exists diffmergeid]} {
6826             gettreediffs $diffids
6827         }
6828     } else {
6829         addtocflist $ids
6830     }
6831     return 0
6832 }
6833
6834 # empty string or positive integer
6835 proc diffcontextvalidate {v} {
6836     return [regexp {^(|[1-9][0-9]*)$} $v]
6837 }
6838
6839 proc diffcontextchange {n1 n2 op} {
6840     global diffcontextstring diffcontext
6841
6842     if {[string is integer -strict $diffcontextstring]} {
6843         if {$diffcontextstring > 0} {
6844             set diffcontext $diffcontextstring
6845             reselectline
6846         }
6847     }
6848 }
6849
6850 proc changeignorespace {} {
6851     reselectline
6852 }
6853
6854 proc getblobdiffs {ids} {
6855     global blobdifffd diffids env
6856     global diffinhdr treediffs
6857     global diffcontext
6858     global ignorespace
6859     global limitdiffs vfilelimit curview
6860     global diffencoding targetline diffnparents
6861
6862     set cmd [diffcmd $ids "-p -C --cc --no-commit-id -U$diffcontext"]
6863     if {$ignorespace} {
6864         append cmd " -w"
6865     }
6866     if {$limitdiffs && $vfilelimit($curview) ne {}} {
6867         set cmd [concat $cmd -- $vfilelimit($curview)]
6868     }
6869     if {[catch {set bdf [open $cmd r]} err]} {
6870         error_popup [mc "Error getting diffs: %s" $err]
6871         return
6872     }
6873     set targetline {}
6874     set diffnparents 0
6875     set diffinhdr 0
6876     set diffencoding [get_path_encoding {}]
6877     fconfigure $bdf -blocking 0 -encoding binary
6878     set blobdifffd($ids) $bdf
6879     filerun $bdf [list getblobdiffline $bdf $diffids]
6880 }
6881
6882 proc setinlist {var i val} {
6883     global $var
6884
6885     while {[llength [set $var]] < $i} {
6886         lappend $var {}
6887     }
6888     if {[llength [set $var]] == $i} {
6889         lappend $var $val
6890     } else {
6891         lset $var $i $val
6892     }
6893 }
6894
6895 proc makediffhdr {fname ids} {
6896     global ctext curdiffstart treediffs diffencoding
6897     global ctext_file_names jump_to_here targetline diffline
6898
6899     set fname [encoding convertfrom $fname]
6900     set diffencoding [get_path_encoding $fname]
6901     set i [lsearch -exact $treediffs($ids) $fname]
6902     if {$i >= 0} {
6903         setinlist difffilestart $i $curdiffstart
6904     }
6905     set ctext_file_names [lreplace $ctext_file_names end end $fname]
6906     set l [expr {(78 - [string length $fname]) / 2}]
6907     set pad [string range "----------------------------------------" 1 $l]
6908     $ctext insert $curdiffstart "$pad $fname $pad" filesep
6909     set targetline {}
6910     if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
6911         set targetline [lindex $jump_to_here 1]
6912     }
6913     set diffline 0
6914 }
6915
6916 proc getblobdiffline {bdf ids} {
6917     global diffids blobdifffd ctext curdiffstart
6918     global diffnexthead diffnextnote difffilestart
6919     global ctext_file_names ctext_file_lines
6920     global diffinhdr treediffs mergemax diffnparents
6921     global diffencoding jump_to_here targetline diffline
6922
6923     set nr 0
6924     $ctext conf -state normal
6925     while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
6926         if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
6927             close $bdf
6928             return 0
6929         }
6930         if {![string compare -length 5 "diff " $line]} {
6931             if {![regexp {^diff (--cc|--git) } $line m type]} {
6932                 set line [encoding convertfrom $line]
6933                 $ctext insert end "$line\n" hunksep
6934                 continue
6935             }
6936             # start of a new file
6937             set diffinhdr 1
6938             $ctext insert end "\n"
6939             set curdiffstart [$ctext index "end - 1c"]
6940             lappend ctext_file_names ""
6941             lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
6942             $ctext insert end "\n" filesep
6943
6944             if {$type eq "--cc"} {
6945                 # start of a new file in a merge diff
6946                 set fname [string range $line 10 end]
6947                 if {[lsearch -exact $treediffs($ids) $fname] < 0} {
6948                     lappend treediffs($ids) $fname
6949                     add_flist [list $fname]
6950                 }
6951
6952             } else {
6953                 set line [string range $line 11 end]
6954                 # If the name hasn't changed the length will be odd,
6955                 # the middle char will be a space, and the two bits either
6956                 # side will be a/name and b/name, or "a/name" and "b/name".
6957                 # If the name has changed we'll get "rename from" and
6958                 # "rename to" or "copy from" and "copy to" lines following
6959                 # this, and we'll use them to get the filenames.
6960                 # This complexity is necessary because spaces in the
6961                 # filename(s) don't get escaped.
6962                 set l [string length $line]
6963                 set i [expr {$l / 2}]
6964                 if {!(($l & 1) && [string index $line $i] eq " " &&
6965                       [string range $line 2 [expr {$i - 1}]] eq \
6966                           [string range $line [expr {$i + 3}] end])} {
6967                     continue
6968                 }
6969                 # unescape if quoted and chop off the a/ from the front
6970                 if {[string index $line 0] eq "\""} {
6971                     set fname [string range [lindex $line 0] 2 end]
6972                 } else {
6973                     set fname [string range $line 2 [expr {$i - 1}]]
6974                 }
6975             }
6976             makediffhdr $fname $ids
6977
6978         } elseif {![string compare -length 2 "@@" $line]} {
6979             regexp {^@@+} $line ats
6980             set line [encoding convertfrom $diffencoding $line]
6981             $ctext insert end "$line\n" hunksep
6982             if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
6983                 set diffline $nl
6984             }
6985             set diffnparents [expr {[string length $ats] - 1}]
6986             set diffinhdr 0
6987
6988         } elseif {$diffinhdr} {
6989             if {![string compare -length 12 "rename from " $line]} {
6990                 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
6991                 if {[string index $fname 0] eq "\""} {
6992                     set fname [lindex $fname 0]
6993                 }
6994                 set fname [encoding convertfrom $fname]
6995                 set i [lsearch -exact $treediffs($ids) $fname]
6996                 if {$i >= 0} {
6997                     setinlist difffilestart $i $curdiffstart
6998                 }
6999             } elseif {![string compare -length 10 $line "rename to "] ||
7000                       ![string compare -length 8 $line "copy to "]} {
7001                 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
7002                 if {[string index $fname 0] eq "\""} {
7003                     set fname [lindex $fname 0]
7004                 }
7005                 makediffhdr $fname $ids
7006             } elseif {[string compare -length 3 $line "---"] == 0} {
7007                 # do nothing
7008                 continue
7009             } elseif {[string compare -length 3 $line "+++"] == 0} {
7010                 set diffinhdr 0
7011                 continue
7012             }
7013             $ctext insert end "$line\n" filesep
7014
7015         } else {
7016             set line [encoding convertfrom $diffencoding $line]
7017             # parse the prefix - one ' ', '-' or '+' for each parent
7018             set prefix [string range $line 0 [expr {$diffnparents - 1}]]
7019             set tag [expr {$diffnparents > 1? "m": "d"}]
7020             if {[string trim $prefix " -+"] eq {}} {
7021                 # prefix only has " ", "-" and "+" in it: normal diff line
7022                 set num [string first "-" $prefix]
7023                 if {$num >= 0} {
7024                     # removed line, first parent with line is $num
7025                     if {$num >= $mergemax} {
7026                         set num "max"
7027                     }
7028                     $ctext insert end "$line\n" $tag$num
7029                 } else {
7030                     set tags {}
7031                     if {[string first "+" $prefix] >= 0} {
7032                         # added line
7033                         lappend tags ${tag}result
7034                         if {$diffnparents > 1} {
7035                             set num [string first " " $prefix]
7036                             if {$num >= 0} {
7037                                 if {$num >= $mergemax} {
7038                                     set num "max"
7039                                 }
7040                                 lappend tags m$num
7041                             }
7042                         }
7043                     }
7044                     if {$targetline ne {}} {
7045                         if {$diffline == $targetline} {
7046                             set seehere [$ctext index "end - 1 chars"]
7047                             set targetline {}
7048                         } else {
7049                             incr diffline
7050                         }
7051                     }
7052                     $ctext insert end "$line\n" $tags
7053                 }
7054             } else {
7055                 # "\ No newline at end of file",
7056                 # or something else we don't recognize
7057                 $ctext insert end "$line\n" hunksep
7058             }
7059         }
7060     }
7061     if {[info exists seehere]} {
7062         mark_ctext_line [lindex [split $seehere .] 0]
7063     }
7064     $ctext conf -state disabled
7065     if {[eof $bdf]} {
7066         close $bdf
7067         return 0
7068     }
7069     return [expr {$nr >= 1000? 2: 1}]
7070 }
7071
7072 proc changediffdisp {} {
7073     global ctext diffelide
7074
7075     $ctext tag conf d0 -elide [lindex $diffelide 0]
7076     $ctext tag conf dresult -elide [lindex $diffelide 1]
7077 }
7078
7079 proc highlightfile {loc cline} {
7080     global ctext cflist cflist_top
7081
7082     $ctext yview $loc
7083     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
7084     $cflist tag add highlight $cline.0 "$cline.0 lineend"
7085     $cflist see $cline.0
7086     set cflist_top $cline
7087 }
7088
7089 proc prevfile {} {
7090     global difffilestart ctext cmitmode
7091
7092     if {$cmitmode eq "tree"} return
7093     set prev 0.0
7094     set prevline 1
7095     set here [$ctext index @0,0]
7096     foreach loc $difffilestart {
7097         if {[$ctext compare $loc >= $here]} {
7098             highlightfile $prev $prevline
7099             return
7100         }
7101         set prev $loc
7102         incr prevline
7103     }
7104     highlightfile $prev $prevline
7105 }
7106
7107 proc nextfile {} {
7108     global difffilestart ctext cmitmode
7109
7110     if {$cmitmode eq "tree"} return
7111     set here [$ctext index @0,0]
7112     set line 1
7113     foreach loc $difffilestart {
7114         incr line
7115         if {[$ctext compare $loc > $here]} {
7116             highlightfile $loc $line
7117             return
7118         }
7119     }
7120 }
7121
7122 proc clear_ctext {{first 1.0}} {
7123     global ctext smarktop smarkbot
7124     global ctext_file_names ctext_file_lines
7125     global pendinglinks
7126
7127     set l [lindex [split $first .] 0]
7128     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
7129         set smarktop $l
7130     }
7131     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
7132         set smarkbot $l
7133     }
7134     $ctext delete $first end
7135     if {$first eq "1.0"} {
7136         catch {unset pendinglinks}
7137     }
7138     set ctext_file_names {}
7139     set ctext_file_lines {}
7140 }
7141
7142 proc settabs {{firstab {}}} {
7143     global firsttabstop tabstop ctext have_tk85
7144
7145     if {$firstab ne {} && $have_tk85} {
7146         set firsttabstop $firstab
7147     }
7148     set w [font measure textfont "0"]
7149     if {$firsttabstop != 0} {
7150         $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
7151                                [expr {($firsttabstop + 2 * $tabstop) * $w}]]
7152     } elseif {$have_tk85 || $tabstop != 8} {
7153         $ctext conf -tabs [expr {$tabstop * $w}]
7154     } else {
7155         $ctext conf -tabs {}
7156     }
7157 }
7158
7159 proc incrsearch {name ix op} {
7160     global ctext searchstring searchdirn
7161
7162     $ctext tag remove found 1.0 end
7163     if {[catch {$ctext index anchor}]} {
7164         # no anchor set, use start of selection, or of visible area
7165         set sel [$ctext tag ranges sel]
7166         if {$sel ne {}} {
7167             $ctext mark set anchor [lindex $sel 0]
7168         } elseif {$searchdirn eq "-forwards"} {
7169             $ctext mark set anchor @0,0
7170         } else {
7171             $ctext mark set anchor @0,[winfo height $ctext]
7172         }
7173     }
7174     if {$searchstring ne {}} {
7175         set here [$ctext search $searchdirn -- $searchstring anchor]
7176         if {$here ne {}} {
7177             $ctext see $here
7178         }
7179         searchmarkvisible 1
7180     }
7181 }
7182
7183 proc dosearch {} {
7184     global sstring ctext searchstring searchdirn
7185
7186     focus $sstring
7187     $sstring icursor end
7188     set searchdirn -forwards
7189     if {$searchstring ne {}} {
7190         set sel [$ctext tag ranges sel]
7191         if {$sel ne {}} {
7192             set start "[lindex $sel 0] + 1c"
7193         } elseif {[catch {set start [$ctext index anchor]}]} {
7194             set start "@0,0"
7195         }
7196         set match [$ctext search -count mlen -- $searchstring $start]
7197         $ctext tag remove sel 1.0 end
7198         if {$match eq {}} {
7199             bell
7200             return
7201         }
7202         $ctext see $match
7203         set mend "$match + $mlen c"
7204         $ctext tag add sel $match $mend
7205         $ctext mark unset anchor
7206     }
7207 }
7208
7209 proc dosearchback {} {
7210     global sstring ctext searchstring searchdirn
7211
7212     focus $sstring
7213     $sstring icursor end
7214     set searchdirn -backwards
7215     if {$searchstring ne {}} {
7216         set sel [$ctext tag ranges sel]
7217         if {$sel ne {}} {
7218             set start [lindex $sel 0]
7219         } elseif {[catch {set start [$ctext index anchor]}]} {
7220             set start @0,[winfo height $ctext]
7221         }
7222         set match [$ctext search -backwards -count ml -- $searchstring $start]
7223         $ctext tag remove sel 1.0 end
7224         if {$match eq {}} {
7225             bell
7226             return
7227         }
7228         $ctext see $match
7229         set mend "$match + $ml c"
7230         $ctext tag add sel $match $mend
7231         $ctext mark unset anchor
7232     }
7233 }
7234
7235 proc searchmark {first last} {
7236     global ctext searchstring
7237
7238     set mend $first.0
7239     while {1} {
7240         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
7241         if {$match eq {}} break
7242         set mend "$match + $mlen c"
7243         $ctext tag add found $match $mend
7244     }
7245 }
7246
7247 proc searchmarkvisible {doall} {
7248     global ctext smarktop smarkbot
7249
7250     set topline [lindex [split [$ctext index @0,0] .] 0]
7251     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
7252     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
7253         # no overlap with previous
7254         searchmark $topline $botline
7255         set smarktop $topline
7256         set smarkbot $botline
7257     } else {
7258         if {$topline < $smarktop} {
7259             searchmark $topline [expr {$smarktop-1}]
7260             set smarktop $topline
7261         }
7262         if {$botline > $smarkbot} {
7263             searchmark [expr {$smarkbot+1}] $botline
7264             set smarkbot $botline
7265         }
7266     }
7267 }
7268
7269 proc scrolltext {f0 f1} {
7270     global searchstring
7271
7272     .bleft.bottom.sb set $f0 $f1
7273     if {$searchstring ne {}} {
7274         searchmarkvisible 0
7275     }
7276 }
7277
7278 proc setcoords {} {
7279     global linespc charspc canvx0 canvy0
7280     global xspc1 xspc2 lthickness
7281
7282     set linespc [font metrics mainfont -linespace]
7283     set charspc [font measure mainfont "m"]
7284     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
7285     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
7286     set lthickness [expr {int($linespc / 9) + 1}]
7287     set xspc1(0) $linespc
7288     set xspc2 $linespc
7289 }
7290
7291 proc redisplay {} {
7292     global canv
7293     global selectedline
7294
7295     set ymax [lindex [$canv cget -scrollregion] 3]
7296     if {$ymax eq {} || $ymax == 0} return
7297     set span [$canv yview]
7298     clear_display
7299     setcanvscroll
7300     allcanvs yview moveto [lindex $span 0]
7301     drawvisible
7302     if {$selectedline ne {}} {
7303         selectline $selectedline 0
7304         allcanvs yview moveto [lindex $span 0]
7305     }
7306 }
7307
7308 proc parsefont {f n} {
7309     global fontattr
7310
7311     set fontattr($f,family) [lindex $n 0]
7312     set s [lindex $n 1]
7313     if {$s eq {} || $s == 0} {
7314         set s 10
7315     } elseif {$s < 0} {
7316         set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
7317     }
7318     set fontattr($f,size) $s
7319     set fontattr($f,weight) normal
7320     set fontattr($f,slant) roman
7321     foreach style [lrange $n 2 end] {
7322         switch -- $style {
7323             "normal" -
7324             "bold"   {set fontattr($f,weight) $style}
7325             "roman" -
7326             "italic" {set fontattr($f,slant) $style}
7327         }
7328     }
7329 }
7330
7331 proc fontflags {f {isbold 0}} {
7332     global fontattr
7333
7334     return [list -family $fontattr($f,family) -size $fontattr($f,size) \
7335                 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
7336                 -slant $fontattr($f,slant)]
7337 }
7338
7339 proc fontname {f} {
7340     global fontattr
7341
7342     set n [list $fontattr($f,family) $fontattr($f,size)]
7343     if {$fontattr($f,weight) eq "bold"} {
7344         lappend n "bold"
7345     }
7346     if {$fontattr($f,slant) eq "italic"} {
7347         lappend n "italic"
7348     }
7349     return $n
7350 }
7351
7352 proc incrfont {inc} {
7353     global mainfont textfont ctext canv cflist showrefstop
7354     global stopped entries fontattr
7355
7356     unmarkmatches
7357     set s $fontattr(mainfont,size)
7358     incr s $inc
7359     if {$s < 1} {
7360         set s 1
7361     }
7362     set fontattr(mainfont,size) $s
7363     font config mainfont -size $s
7364     font config mainfontbold -size $s
7365     set mainfont [fontname mainfont]
7366     set s $fontattr(textfont,size)
7367     incr s $inc
7368     if {$s < 1} {
7369         set s 1
7370     }
7371     set fontattr(textfont,size) $s
7372     font config textfont -size $s
7373     font config textfontbold -size $s
7374     set textfont [fontname textfont]
7375     setcoords
7376     settabs
7377     redisplay
7378 }
7379
7380 proc clearsha1 {} {
7381     global sha1entry sha1string
7382     if {[string length $sha1string] == 40} {
7383         $sha1entry delete 0 end
7384     }
7385 }
7386
7387 proc sha1change {n1 n2 op} {
7388     global sha1string currentid sha1but
7389     if {$sha1string == {}
7390         || ([info exists currentid] && $sha1string == $currentid)} {
7391         set state disabled
7392     } else {
7393         set state normal
7394     }
7395     if {[$sha1but cget -state] == $state} return
7396     if {$state == "normal"} {
7397         $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
7398     } else {
7399         $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
7400     }
7401 }
7402
7403 proc gotocommit {} {
7404     global sha1string tagids headids curview varcid
7405
7406     if {$sha1string == {}
7407         || ([info exists currentid] && $sha1string == $currentid)} return
7408     if {[info exists tagids($sha1string)]} {
7409         set id $tagids($sha1string)
7410     } elseif {[info exists headids($sha1string)]} {
7411         set id $headids($sha1string)
7412     } else {
7413         set id [string tolower $sha1string]
7414         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
7415             set matches [longid $id]
7416             if {$matches ne {}} {
7417                 if {[llength $matches] > 1} {
7418                     error_popup [mc "Short SHA1 id %s is ambiguous" $id]
7419                     return
7420                 }
7421                 set id [lindex $matches 0]
7422             }
7423         }
7424     }
7425     if {[commitinview $id $curview]} {
7426         selectline [rowofcommit $id] 1
7427         return
7428     }
7429     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
7430         set msg [mc "SHA1 id %s is not known" $sha1string]
7431     } else {
7432         set msg [mc "Tag/Head %s is not known" $sha1string]
7433     }
7434     error_popup $msg
7435 }
7436
7437 proc lineenter {x y id} {
7438     global hoverx hovery hoverid hovertimer
7439     global commitinfo canv
7440
7441     if {![info exists commitinfo($id)] && ![getcommit $id]} return
7442     set hoverx $x
7443     set hovery $y
7444     set hoverid $id
7445     if {[info exists hovertimer]} {
7446         after cancel $hovertimer
7447     }
7448     set hovertimer [after 500 linehover]
7449     $canv delete hover
7450 }
7451
7452 proc linemotion {x y id} {
7453     global hoverx hovery hoverid hovertimer
7454
7455     if {[info exists hoverid] && $id == $hoverid} {
7456         set hoverx $x
7457         set hovery $y
7458         if {[info exists hovertimer]} {
7459             after cancel $hovertimer
7460         }
7461         set hovertimer [after 500 linehover]
7462     }
7463 }
7464
7465 proc lineleave {id} {
7466     global hoverid hovertimer canv
7467
7468     if {[info exists hoverid] && $id == $hoverid} {
7469         $canv delete hover
7470         if {[info exists hovertimer]} {
7471             after cancel $hovertimer
7472             unset hovertimer
7473         }
7474         unset hoverid
7475     }
7476 }
7477
7478 proc linehover {} {
7479     global hoverx hovery hoverid hovertimer
7480     global canv linespc lthickness
7481     global commitinfo
7482
7483     set text [lindex $commitinfo($hoverid) 0]
7484     set ymax [lindex [$canv cget -scrollregion] 3]
7485     if {$ymax == {}} return
7486     set yfrac [lindex [$canv yview] 0]
7487     set x [expr {$hoverx + 2 * $linespc}]
7488     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
7489     set x0 [expr {$x - 2 * $lthickness}]
7490     set y0 [expr {$y - 2 * $lthickness}]
7491     set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
7492     set y1 [expr {$y + $linespc + 2 * $lthickness}]
7493     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
7494                -fill \#ffff80 -outline black -width 1 -tags hover]
7495     $canv raise $t
7496     set t [$canv create text $x $y -anchor nw -text $text -tags hover \
7497                -font mainfont]
7498     $canv raise $t
7499 }
7500
7501 proc clickisonarrow {id y} {
7502     global lthickness
7503
7504     set ranges [rowranges $id]
7505     set thresh [expr {2 * $lthickness + 6}]
7506     set n [expr {[llength $ranges] - 1}]
7507     for {set i 1} {$i < $n} {incr i} {
7508         set row [lindex $ranges $i]
7509         if {abs([yc $row] - $y) < $thresh} {
7510             return $i
7511         }
7512     }
7513     return {}
7514 }
7515
7516 proc arrowjump {id n y} {
7517     global canv
7518
7519     # 1 <-> 2, 3 <-> 4, etc...
7520     set n [expr {(($n - 1) ^ 1) + 1}]
7521     set row [lindex [rowranges $id] $n]
7522     set yt [yc $row]
7523     set ymax [lindex [$canv cget -scrollregion] 3]
7524     if {$ymax eq {} || $ymax <= 0} return
7525     set view [$canv yview]
7526     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
7527     set yfrac [expr {$yt / $ymax - $yspan / 2}]
7528     if {$yfrac < 0} {
7529         set yfrac 0
7530     }
7531     allcanvs yview moveto $yfrac
7532 }
7533
7534 proc lineclick {x y id isnew} {
7535     global ctext commitinfo children canv thickerline curview
7536
7537     if {![info exists commitinfo($id)] && ![getcommit $id]} return
7538     unmarkmatches
7539     unselectline
7540     normalline
7541     $canv delete hover
7542     # draw this line thicker than normal
7543     set thickerline $id
7544     drawlines $id
7545     if {$isnew} {
7546         set ymax [lindex [$canv cget -scrollregion] 3]
7547         if {$ymax eq {}} return
7548         set yfrac [lindex [$canv yview] 0]
7549         set y [expr {$y + $yfrac * $ymax}]
7550     }
7551     set dirn [clickisonarrow $id $y]
7552     if {$dirn ne {}} {
7553         arrowjump $id $dirn $y
7554         return
7555     }
7556
7557     if {$isnew} {
7558         addtohistory [list lineclick $x $y $id 0]
7559     }
7560     # fill the details pane with info about this line
7561     $ctext conf -state normal
7562     clear_ctext
7563     settabs 0
7564     $ctext insert end "[mc "Parent"]:\t"
7565     $ctext insert end $id link0
7566     setlink $id link0
7567     set info $commitinfo($id)
7568     $ctext insert end "\n\t[lindex $info 0]\n"
7569     $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
7570     set date [formatdate [lindex $info 2]]
7571     $ctext insert end "\t[mc "Date"]:\t$date\n"
7572     set kids $children($curview,$id)
7573     if {$kids ne {}} {
7574         $ctext insert end "\n[mc "Children"]:"
7575         set i 0
7576         foreach child $kids {
7577             incr i
7578             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
7579             set info $commitinfo($child)
7580             $ctext insert end "\n\t"
7581             $ctext insert end $child link$i
7582             setlink $child link$i
7583             $ctext insert end "\n\t[lindex $info 0]"
7584             $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
7585             set date [formatdate [lindex $info 2]]
7586             $ctext insert end "\n\t[mc "Date"]:\t$date\n"
7587         }
7588     }
7589     $ctext conf -state disabled
7590     init_flist {}
7591 }
7592
7593 proc normalline {} {
7594     global thickerline
7595     if {[info exists thickerline]} {
7596         set id $thickerline
7597         unset thickerline
7598         drawlines $id
7599     }
7600 }
7601
7602 proc selbyid {id} {
7603     global curview
7604     if {[commitinview $id $curview]} {
7605         selectline [rowofcommit $id] 1
7606     }
7607 }
7608
7609 proc mstime {} {
7610     global startmstime
7611     if {![info exists startmstime]} {
7612         set startmstime [clock clicks -milliseconds]
7613     }
7614     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
7615 }
7616
7617 proc rowmenu {x y id} {
7618     global rowctxmenu selectedline rowmenuid curview
7619     global nullid nullid2 fakerowmenu mainhead
7620
7621     stopfinding
7622     set rowmenuid $id
7623     if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
7624         set state disabled
7625     } else {
7626         set state normal
7627     }
7628     if {$id ne $nullid && $id ne $nullid2} {
7629         set menu $rowctxmenu
7630         if {$mainhead ne {}} {
7631             $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
7632         } else {
7633             $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
7634         }
7635     } else {
7636         set menu $fakerowmenu
7637     }
7638     $menu entryconfigure [mca "Diff this -> selected"] -state $state
7639     $menu entryconfigure [mca "Diff selected -> this"] -state $state
7640     $menu entryconfigure [mca "Make patch"] -state $state
7641     tk_popup $menu $x $y
7642 }
7643
7644 proc diffvssel {dirn} {
7645     global rowmenuid selectedline
7646
7647     if {$selectedline eq {}} return
7648     if {$dirn} {
7649         set oldid [commitonrow $selectedline]
7650         set newid $rowmenuid
7651     } else {
7652         set oldid $rowmenuid
7653         set newid [commitonrow $selectedline]
7654     }
7655     addtohistory [list doseldiff $oldid $newid]
7656     doseldiff $oldid $newid
7657 }
7658
7659 proc doseldiff {oldid newid} {
7660     global ctext
7661     global commitinfo
7662
7663     $ctext conf -state normal
7664     clear_ctext
7665     init_flist [mc "Top"]
7666     $ctext insert end "[mc "From"] "
7667     $ctext insert end $oldid link0
7668     setlink $oldid link0
7669     $ctext insert end "\n     "
7670     $ctext insert end [lindex $commitinfo($oldid) 0]
7671     $ctext insert end "\n\n[mc "To"]   "
7672     $ctext insert end $newid link1
7673     setlink $newid link1
7674     $ctext insert end "\n     "
7675     $ctext insert end [lindex $commitinfo($newid) 0]
7676     $ctext insert end "\n"
7677     $ctext conf -state disabled
7678     $ctext tag remove found 1.0 end
7679     startdiff [list $oldid $newid]
7680 }
7681
7682 proc mkpatch {} {
7683     global rowmenuid currentid commitinfo patchtop patchnum
7684
7685     if {![info exists currentid]} return
7686     set oldid $currentid
7687     set oldhead [lindex $commitinfo($oldid) 0]
7688     set newid $rowmenuid
7689     set newhead [lindex $commitinfo($newid) 0]
7690     set top .patch
7691     set patchtop $top
7692     catch {destroy $top}
7693     toplevel $top
7694     label $top.title -text [mc "Generate patch"]
7695     grid $top.title - -pady 10
7696     label $top.from -text [mc "From:"]
7697     entry $top.fromsha1 -width 40 -relief flat
7698     $top.fromsha1 insert 0 $oldid
7699     $top.fromsha1 conf -state readonly
7700     grid $top.from $top.fromsha1 -sticky w
7701     entry $top.fromhead -width 60 -relief flat
7702     $top.fromhead insert 0 $oldhead
7703     $top.fromhead conf -state readonly
7704     grid x $top.fromhead -sticky w
7705     label $top.to -text [mc "To:"]
7706     entry $top.tosha1 -width 40 -relief flat
7707     $top.tosha1 insert 0 $newid
7708     $top.tosha1 conf -state readonly
7709     grid $top.to $top.tosha1 -sticky w
7710     entry $top.tohead -width 60 -relief flat
7711     $top.tohead insert 0 $newhead
7712     $top.tohead conf -state readonly
7713     grid x $top.tohead -sticky w
7714     button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
7715     grid $top.rev x -pady 10
7716     label $top.flab -text [mc "Output file:"]
7717     entry $top.fname -width 60
7718     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
7719     incr patchnum
7720     grid $top.flab $top.fname -sticky w
7721     frame $top.buts
7722     button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
7723     button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
7724     grid $top.buts.gen $top.buts.can
7725     grid columnconfigure $top.buts 0 -weight 1 -uniform a
7726     grid columnconfigure $top.buts 1 -weight 1 -uniform a
7727     grid $top.buts - -pady 10 -sticky ew
7728     focus $top.fname
7729 }
7730
7731 proc mkpatchrev {} {
7732     global patchtop
7733
7734     set oldid [$patchtop.fromsha1 get]
7735     set oldhead [$patchtop.fromhead get]
7736     set newid [$patchtop.tosha1 get]
7737     set newhead [$patchtop.tohead get]
7738     foreach e [list fromsha1 fromhead tosha1 tohead] \
7739             v [list $newid $newhead $oldid $oldhead] {
7740         $patchtop.$e conf -state normal
7741         $patchtop.$e delete 0 end
7742         $patchtop.$e insert 0 $v
7743         $patchtop.$e conf -state readonly
7744     }
7745 }
7746
7747 proc mkpatchgo {} {
7748     global patchtop nullid nullid2
7749
7750     set oldid [$patchtop.fromsha1 get]
7751     set newid [$patchtop.tosha1 get]
7752     set fname [$patchtop.fname get]
7753     set cmd [diffcmd [list $oldid $newid] -p]
7754     # trim off the initial "|"
7755     set cmd [lrange $cmd 1 end]
7756     lappend cmd >$fname &
7757     if {[catch {eval exec $cmd} err]} {
7758         error_popup "[mc "Error creating patch:"] $err"
7759     }
7760     catch {destroy $patchtop}
7761     unset patchtop
7762 }
7763
7764 proc mkpatchcan {} {
7765     global patchtop
7766
7767     catch {destroy $patchtop}
7768     unset patchtop
7769 }
7770
7771 proc mktag {} {
7772     global rowmenuid mktagtop commitinfo
7773
7774     set top .maketag
7775     set mktagtop $top
7776     catch {destroy $top}
7777     toplevel $top
7778     label $top.title -text [mc "Create tag"]
7779     grid $top.title - -pady 10
7780     label $top.id -text [mc "ID:"]
7781     entry $top.sha1 -width 40 -relief flat
7782     $top.sha1 insert 0 $rowmenuid
7783     $top.sha1 conf -state readonly
7784     grid $top.id $top.sha1 -sticky w
7785     entry $top.head -width 60 -relief flat
7786     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
7787     $top.head conf -state readonly
7788     grid x $top.head -sticky w
7789     label $top.tlab -text [mc "Tag name:"]
7790     entry $top.tag -width 60
7791     grid $top.tlab $top.tag -sticky w
7792     frame $top.buts
7793     button $top.buts.gen -text [mc "Create"] -command mktaggo
7794     button $top.buts.can -text [mc "Cancel"] -command mktagcan
7795     grid $top.buts.gen $top.buts.can
7796     grid columnconfigure $top.buts 0 -weight 1 -uniform a
7797     grid columnconfigure $top.buts 1 -weight 1 -uniform a
7798     grid $top.buts - -pady 10 -sticky ew
7799     focus $top.tag
7800 }
7801
7802 proc domktag {} {
7803     global mktagtop env tagids idtags
7804
7805     set id [$mktagtop.sha1 get]
7806     set tag [$mktagtop.tag get]
7807     if {$tag == {}} {
7808         error_popup [mc "No tag name specified"]
7809         return
7810     }
7811     if {[info exists tagids($tag)]} {
7812         error_popup [mc "Tag \"%s\" already exists" $tag]
7813         return
7814     }
7815     if {[catch {
7816         exec git tag $tag $id
7817     } err]} {
7818         error_popup "[mc "Error creating tag:"] $err"
7819         return
7820     }
7821
7822     set tagids($tag) $id
7823     lappend idtags($id) $tag
7824     redrawtags $id
7825     addedtag $id
7826     dispneartags 0
7827     run refill_reflist
7828 }
7829
7830 proc redrawtags {id} {
7831     global canv linehtag idpos currentid curview cmitlisted
7832     global canvxmax iddrawn circleitem mainheadid circlecolors
7833
7834     if {![commitinview $id $curview]} return
7835     if {![info exists iddrawn($id)]} return
7836     set row [rowofcommit $id]
7837     if {$id eq $mainheadid} {
7838         set ofill yellow
7839     } else {
7840         set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
7841     }
7842     $canv itemconf $circleitem($row) -fill $ofill
7843     $canv delete tag.$id
7844     set xt [eval drawtags $id $idpos($id)]
7845     $canv coords $linehtag($row) $xt [lindex $idpos($id) 2]
7846     set text [$canv itemcget $linehtag($row) -text]
7847     set font [$canv itemcget $linehtag($row) -font]
7848     set xr [expr {$xt + [font measure $font $text]}]
7849     if {$xr > $canvxmax} {
7850         set canvxmax $xr
7851         setcanvscroll
7852     }
7853     if {[info exists currentid] && $currentid == $id} {
7854         make_secsel $row
7855     }
7856 }
7857
7858 proc mktagcan {} {
7859     global mktagtop
7860
7861     catch {destroy $mktagtop}
7862     unset mktagtop
7863 }
7864
7865 proc mktaggo {} {
7866     domktag
7867     mktagcan
7868 }
7869
7870 proc writecommit {} {
7871     global rowmenuid wrcomtop commitinfo wrcomcmd
7872
7873     set top .writecommit
7874     set wrcomtop $top
7875     catch {destroy $top}
7876     toplevel $top
7877     label $top.title -text [mc "Write commit to file"]
7878     grid $top.title - -pady 10
7879     label $top.id -text [mc "ID:"]
7880     entry $top.sha1 -width 40 -relief flat
7881     $top.sha1 insert 0 $rowmenuid
7882     $top.sha1 conf -state readonly
7883     grid $top.id $top.sha1 -sticky w
7884     entry $top.head -width 60 -relief flat
7885     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
7886     $top.head conf -state readonly
7887     grid x $top.head -sticky w
7888     label $top.clab -text [mc "Command:"]
7889     entry $top.cmd -width 60 -textvariable wrcomcmd
7890     grid $top.clab $top.cmd -sticky w -pady 10
7891     label $top.flab -text [mc "Output file:"]
7892     entry $top.fname -width 60
7893     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
7894     grid $top.flab $top.fname -sticky w
7895     frame $top.buts
7896     button $top.buts.gen -text [mc "Write"] -command wrcomgo
7897     button $top.buts.can -text [mc "Cancel"] -command wrcomcan
7898     grid $top.buts.gen $top.buts.can
7899     grid columnconfigure $top.buts 0 -weight 1 -uniform a
7900     grid columnconfigure $top.buts 1 -weight 1 -uniform a
7901     grid $top.buts - -pady 10 -sticky ew
7902     focus $top.fname
7903 }
7904
7905 proc wrcomgo {} {
7906     global wrcomtop
7907
7908     set id [$wrcomtop.sha1 get]
7909     set cmd "echo $id | [$wrcomtop.cmd get]"
7910     set fname [$wrcomtop.fname get]
7911     if {[catch {exec sh -c $cmd >$fname &} err]} {
7912         error_popup "[mc "Error writing commit:"] $err"
7913     }
7914     catch {destroy $wrcomtop}
7915     unset wrcomtop
7916 }
7917
7918 proc wrcomcan {} {
7919     global wrcomtop
7920
7921     catch {destroy $wrcomtop}
7922     unset wrcomtop
7923 }
7924
7925 proc mkbranch {} {
7926     global rowmenuid mkbrtop
7927
7928     set top .makebranch
7929     catch {destroy $top}
7930     toplevel $top
7931     label $top.title -text [mc "Create new branch"]
7932     grid $top.title - -pady 10
7933     label $top.id -text [mc "ID:"]
7934     entry $top.sha1 -width 40 -relief flat
7935     $top.sha1 insert 0 $rowmenuid
7936     $top.sha1 conf -state readonly
7937     grid $top.id $top.sha1 -sticky w
7938     label $top.nlab -text [mc "Name:"]
7939     entry $top.name -width 40
7940     bind $top.name <Key-Return> "[list mkbrgo $top]"
7941     grid $top.nlab $top.name -sticky w
7942     frame $top.buts
7943     button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
7944     button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
7945     grid $top.buts.go $top.buts.can
7946     grid columnconfigure $top.buts 0 -weight 1 -uniform a
7947     grid columnconfigure $top.buts 1 -weight 1 -uniform a
7948     grid $top.buts - -pady 10 -sticky ew
7949     focus $top.name
7950 }
7951
7952 proc mkbrgo {top} {
7953     global headids idheads
7954
7955     set name [$top.name get]
7956     set id [$top.sha1 get]
7957     set cmdargs {}
7958     set old_id {}
7959     if {$name eq {}} {
7960         error_popup [mc "Please specify a name for the new branch"]
7961         return
7962     }
7963     if {[info exists headids($name)]} {
7964         if {![confirm_popup [mc \
7965                 "Branch '%s' already exists. Overwrite?" $name]]} {
7966             return
7967         }
7968         set old_id $headids($name)
7969         lappend cmdargs -f
7970     }
7971     catch {destroy $top}
7972     lappend cmdargs $name $id
7973     nowbusy newbranch
7974     update
7975     if {[catch {
7976         eval exec git branch $cmdargs
7977     } err]} {
7978         notbusy newbranch
7979         error_popup $err
7980     } else {
7981         notbusy newbranch
7982         if {$old_id ne {}} {
7983             movehead $id $name
7984             movedhead $id $name
7985             redrawtags $old_id
7986             redrawtags $id
7987         } else {
7988             set headids($name) $id
7989             lappend idheads($id) $name
7990             addedhead $id $name
7991             redrawtags $id
7992         }
7993         dispneartags 0
7994         run refill_reflist
7995     }
7996 }
7997
7998 proc cherrypick {} {
7999     global rowmenuid curview
8000     global mainhead mainheadid
8001
8002     set oldhead [exec git rev-parse HEAD]
8003     set dheads [descheads $rowmenuid]
8004     if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
8005         set ok [confirm_popup [mc "Commit %s is already\
8006                 included in branch %s -- really re-apply it?" \
8007                                    [string range $rowmenuid 0 7] $mainhead]]
8008         if {!$ok} return
8009     }
8010     nowbusy cherrypick [mc "Cherry-picking"]
8011     update
8012     # Unfortunately git-cherry-pick writes stuff to stderr even when
8013     # no error occurs, and exec takes that as an indication of error...
8014     if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
8015         notbusy cherrypick
8016         error_popup $err
8017         return
8018     }
8019     set newhead [exec git rev-parse HEAD]
8020     if {$newhead eq $oldhead} {
8021         notbusy cherrypick
8022         error_popup [mc "No changes committed"]
8023         return
8024     }
8025     addnewchild $newhead $oldhead
8026     if {[commitinview $oldhead $curview]} {
8027         insertrow $newhead $oldhead $curview
8028         if {$mainhead ne {}} {
8029             movehead $newhead $mainhead
8030             movedhead $newhead $mainhead
8031         }
8032         set mainheadid $newhead
8033         redrawtags $oldhead
8034         redrawtags $newhead
8035         selbyid $newhead
8036     }
8037     notbusy cherrypick
8038 }
8039
8040 proc resethead {} {
8041     global mainhead rowmenuid confirm_ok resettype
8042
8043     set confirm_ok 0
8044     set w ".confirmreset"
8045     toplevel $w
8046     wm transient $w .
8047     wm title $w [mc "Confirm reset"]
8048     message $w.m -text \
8049         [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
8050         -justify center -aspect 1000
8051     pack $w.m -side top -fill x -padx 20 -pady 20
8052     frame $w.f -relief sunken -border 2
8053     message $w.f.rt -text [mc "Reset type:"] -aspect 1000
8054     grid $w.f.rt -sticky w
8055     set resettype mixed
8056     radiobutton $w.f.soft -value soft -variable resettype -justify left \
8057         -text [mc "Soft: Leave working tree and index untouched"]
8058     grid $w.f.soft -sticky w
8059     radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
8060         -text [mc "Mixed: Leave working tree untouched, reset index"]
8061     grid $w.f.mixed -sticky w
8062     radiobutton $w.f.hard -value hard -variable resettype -justify left \
8063         -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
8064     grid $w.f.hard -sticky w
8065     pack $w.f -side top -fill x
8066     button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
8067     pack $w.ok -side left -fill x -padx 20 -pady 20
8068     button $w.cancel -text [mc Cancel] -command "destroy $w"
8069     pack $w.cancel -side right -fill x -padx 20 -pady 20
8070     bind $w <Visibility> "grab $w; focus $w"
8071     tkwait window $w
8072     if {!$confirm_ok} return
8073     if {[catch {set fd [open \
8074             [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
8075         error_popup $err
8076     } else {
8077         dohidelocalchanges
8078         filerun $fd [list readresetstat $fd]
8079         nowbusy reset [mc "Resetting"]
8080         selbyid $rowmenuid
8081     }
8082 }
8083
8084 proc readresetstat {fd} {
8085     global mainhead mainheadid showlocalchanges rprogcoord
8086
8087     if {[gets $fd line] >= 0} {
8088         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
8089             set rprogcoord [expr {1.0 * $m / $n}]
8090             adjustprogress
8091         }
8092         return 1
8093     }
8094     set rprogcoord 0
8095     adjustprogress
8096     notbusy reset
8097     if {[catch {close $fd} err]} {
8098         error_popup $err
8099     }
8100     set oldhead $mainheadid
8101     set newhead [exec git rev-parse HEAD]
8102     if {$newhead ne $oldhead} {
8103         movehead $newhead $mainhead
8104         movedhead $newhead $mainhead
8105         set mainheadid $newhead
8106         redrawtags $oldhead
8107         redrawtags $newhead
8108     }
8109     if {$showlocalchanges} {
8110         doshowlocalchanges
8111     }
8112     return 0
8113 }
8114
8115 # context menu for a head
8116 proc headmenu {x y id head} {
8117     global headmenuid headmenuhead headctxmenu mainhead
8118
8119     stopfinding
8120     set headmenuid $id
8121     set headmenuhead $head
8122     set state normal
8123     if {$head eq $mainhead} {
8124         set state disabled
8125     }
8126     $headctxmenu entryconfigure 0 -state $state
8127     $headctxmenu entryconfigure 1 -state $state
8128     tk_popup $headctxmenu $x $y
8129 }
8130
8131 proc cobranch {} {
8132     global headmenuid headmenuhead headids
8133     global showlocalchanges mainheadid
8134
8135     # check the tree is clean first??
8136     nowbusy checkout [mc "Checking out"]
8137     update
8138     dohidelocalchanges
8139     if {[catch {
8140         set fd [open [list | git checkout $headmenuhead 2>@1] r]
8141     } err]} {
8142         notbusy checkout
8143         error_popup $err
8144         if {$showlocalchanges} {
8145             dodiffindex
8146         }
8147     } else {
8148         filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
8149     }
8150 }
8151
8152 proc readcheckoutstat {fd newhead newheadid} {
8153     global mainhead mainheadid headids showlocalchanges progresscoords
8154
8155     if {[gets $fd line] >= 0} {
8156         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
8157             set progresscoords [list 0 [expr {1.0 * $m / $n}]]
8158             adjustprogress
8159         }
8160         return 1
8161     }
8162     set progresscoords {0 0}
8163     adjustprogress
8164     notbusy checkout
8165     if {[catch {close $fd} err]} {
8166         error_popup $err
8167     }
8168     set oldmainid $mainheadid
8169     set mainhead $newhead
8170     set mainheadid $newheadid
8171     redrawtags $oldmainid
8172     redrawtags $newheadid
8173     selbyid $newheadid
8174     if {$showlocalchanges} {
8175         dodiffindex
8176     }
8177 }
8178
8179 proc rmbranch {} {
8180     global headmenuid headmenuhead mainhead
8181     global idheads
8182
8183     set head $headmenuhead
8184     set id $headmenuid
8185     # this check shouldn't be needed any more...
8186     if {$head eq $mainhead} {
8187         error_popup [mc "Cannot delete the currently checked-out branch"]
8188         return
8189     }
8190     set dheads [descheads $id]
8191     if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
8192         # the stuff on this branch isn't on any other branch
8193         if {![confirm_popup [mc "The commits on branch %s aren't on any other\
8194                         branch.\nReally delete branch %s?" $head $head]]} return
8195     }
8196     nowbusy rmbranch
8197     update
8198     if {[catch {exec git branch -D $head} err]} {
8199         notbusy rmbranch
8200         error_popup $err
8201         return
8202     }
8203     removehead $id $head
8204     removedhead $id $head
8205     redrawtags $id
8206     notbusy rmbranch
8207     dispneartags 0
8208     run refill_reflist
8209 }
8210
8211 # Display a list of tags and heads
8212 proc showrefs {} {
8213     global showrefstop bgcolor fgcolor selectbgcolor
8214     global bglist fglist reflistfilter reflist maincursor
8215
8216     set top .showrefs
8217     set showrefstop $top
8218     if {[winfo exists $top]} {
8219         raise $top
8220         refill_reflist
8221         return
8222     }
8223     toplevel $top
8224     wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
8225     text $top.list -background $bgcolor -foreground $fgcolor \
8226         -selectbackground $selectbgcolor -font mainfont \
8227         -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
8228         -width 30 -height 20 -cursor $maincursor \
8229         -spacing1 1 -spacing3 1 -state disabled
8230     $top.list tag configure highlight -background $selectbgcolor
8231     lappend bglist $top.list
8232     lappend fglist $top.list
8233     scrollbar $top.ysb -command "$top.list yview" -orient vertical
8234     scrollbar $top.xsb -command "$top.list xview" -orient horizontal
8235     grid $top.list $top.ysb -sticky nsew
8236     grid $top.xsb x -sticky ew
8237     frame $top.f
8238     label $top.f.l -text "[mc "Filter"]: "
8239     entry $top.f.e -width 20 -textvariable reflistfilter
8240     set reflistfilter "*"
8241     trace add variable reflistfilter write reflistfilter_change
8242     pack $top.f.e -side right -fill x -expand 1
8243     pack $top.f.l -side left
8244     grid $top.f - -sticky ew -pady 2
8245     button $top.close -command [list destroy $top] -text [mc "Close"]
8246     grid $top.close -
8247     grid columnconfigure $top 0 -weight 1
8248     grid rowconfigure $top 0 -weight 1
8249     bind $top.list <1> {break}
8250     bind $top.list <B1-Motion> {break}
8251     bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
8252     set reflist {}
8253     refill_reflist
8254 }
8255
8256 proc sel_reflist {w x y} {
8257     global showrefstop reflist headids tagids otherrefids
8258
8259     if {![winfo exists $showrefstop]} return
8260     set l [lindex [split [$w index "@$x,$y"] "."] 0]
8261     set ref [lindex $reflist [expr {$l-1}]]
8262     set n [lindex $ref 0]
8263     switch -- [lindex $ref 1] {
8264         "H" {selbyid $headids($n)}
8265         "T" {selbyid $tagids($n)}
8266         "o" {selbyid $otherrefids($n)}
8267     }
8268     $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
8269 }
8270
8271 proc unsel_reflist {} {
8272     global showrefstop
8273
8274     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
8275     $showrefstop.list tag remove highlight 0.0 end
8276 }
8277
8278 proc reflistfilter_change {n1 n2 op} {
8279     global reflistfilter
8280
8281     after cancel refill_reflist
8282     after 200 refill_reflist
8283 }
8284
8285 proc refill_reflist {} {
8286     global reflist reflistfilter showrefstop headids tagids otherrefids
8287     global curview
8288
8289     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
8290     set refs {}
8291     foreach n [array names headids] {
8292         if {[string match $reflistfilter $n]} {
8293             if {[commitinview $headids($n) $curview]} {
8294                 lappend refs [list $n H]
8295             } else {
8296                 interestedin $headids($n) {run refill_reflist}
8297             }
8298         }
8299     }
8300     foreach n [array names tagids] {
8301         if {[string match $reflistfilter $n]} {
8302             if {[commitinview $tagids($n) $curview]} {
8303                 lappend refs [list $n T]
8304             } else {
8305                 interestedin $tagids($n) {run refill_reflist}
8306             }
8307         }
8308     }
8309     foreach n [array names otherrefids] {
8310         if {[string match $reflistfilter $n]} {
8311             if {[commitinview $otherrefids($n) $curview]} {
8312                 lappend refs [list $n o]
8313             } else {
8314                 interestedin $otherrefids($n) {run refill_reflist}
8315             }
8316         }
8317     }
8318     set refs [lsort -index 0 $refs]
8319     if {$refs eq $reflist} return
8320
8321     # Update the contents of $showrefstop.list according to the
8322     # differences between $reflist (old) and $refs (new)
8323     $showrefstop.list conf -state normal
8324     $showrefstop.list insert end "\n"
8325     set i 0
8326     set j 0
8327     while {$i < [llength $reflist] || $j < [llength $refs]} {
8328         if {$i < [llength $reflist]} {
8329             if {$j < [llength $refs]} {
8330                 set cmp [string compare [lindex $reflist $i 0] \
8331                              [lindex $refs $j 0]]
8332                 if {$cmp == 0} {
8333                     set cmp [string compare [lindex $reflist $i 1] \
8334                                  [lindex $refs $j 1]]
8335                 }
8336             } else {
8337                 set cmp -1
8338             }
8339         } else {
8340             set cmp 1
8341         }
8342         switch -- $cmp {
8343             -1 {
8344                 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
8345                 incr i
8346             }
8347             0 {
8348                 incr i
8349                 incr j
8350             }
8351             1 {
8352                 set l [expr {$j + 1}]
8353                 $showrefstop.list image create $l.0 -align baseline \
8354                     -image reficon-[lindex $refs $j 1] -padx 2
8355                 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
8356                 incr j
8357             }
8358         }
8359     }
8360     set reflist $refs
8361     # delete last newline
8362     $showrefstop.list delete end-2c end-1c
8363     $showrefstop.list conf -state disabled
8364 }
8365
8366 # Stuff for finding nearby tags
8367 proc getallcommits {} {
8368     global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
8369     global idheads idtags idotherrefs allparents tagobjid
8370
8371     if {![info exists allcommits]} {
8372         set nextarc 0
8373         set allcommits 0
8374         set seeds {}
8375         set allcwait 0
8376         set cachedarcs 0
8377         set allccache [file join [gitdir] "gitk.cache"]
8378         if {![catch {
8379             set f [open $allccache r]
8380             set allcwait 1
8381             getcache $f
8382         }]} return
8383     }
8384
8385     if {$allcwait} {
8386         return
8387     }
8388     set cmd [list | git rev-list --parents]
8389     set allcupdate [expr {$seeds ne {}}]
8390     if {!$allcupdate} {
8391         set ids "--all"
8392     } else {
8393         set refs [concat [array names idheads] [array names idtags] \
8394                       [array names idotherrefs]]
8395         set ids {}
8396         set tagobjs {}
8397         foreach name [array names tagobjid] {
8398             lappend tagobjs $tagobjid($name)
8399         }
8400         foreach id [lsort -unique $refs] {
8401             if {![info exists allparents($id)] &&
8402                 [lsearch -exact $tagobjs $id] < 0} {
8403                 lappend ids $id
8404             }
8405         }
8406         if {$ids ne {}} {
8407             foreach id $seeds {
8408                 lappend ids "^$id"
8409             }
8410         }
8411     }
8412     if {$ids ne {}} {
8413         set fd [open [concat $cmd $ids] r]
8414         fconfigure $fd -blocking 0
8415         incr allcommits
8416         nowbusy allcommits
8417         filerun $fd [list getallclines $fd]
8418     } else {
8419         dispneartags 0
8420     }
8421 }
8422
8423 # Since most commits have 1 parent and 1 child, we group strings of
8424 # such commits into "arcs" joining branch/merge points (BMPs), which
8425 # are commits that either don't have 1 parent or don't have 1 child.
8426 #
8427 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
8428 # arcout(id) - outgoing arcs for BMP
8429 # arcids(a) - list of IDs on arc including end but not start
8430 # arcstart(a) - BMP ID at start of arc
8431 # arcend(a) - BMP ID at end of arc
8432 # growing(a) - arc a is still growing
8433 # arctags(a) - IDs out of arcids (excluding end) that have tags
8434 # archeads(a) - IDs out of arcids (excluding end) that have heads
8435 # The start of an arc is at the descendent end, so "incoming" means
8436 # coming from descendents, and "outgoing" means going towards ancestors.
8437
8438 proc getallclines {fd} {
8439     global allparents allchildren idtags idheads nextarc
8440     global arcnos arcids arctags arcout arcend arcstart archeads growing
8441     global seeds allcommits cachedarcs allcupdate
8442
8443     set nid 0
8444     while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
8445         set id [lindex $line 0]
8446         if {[info exists allparents($id)]} {
8447             # seen it already
8448             continue
8449         }
8450         set cachedarcs 0
8451         set olds [lrange $line 1 end]
8452         set allparents($id) $olds
8453         if {![info exists allchildren($id)]} {
8454             set allchildren($id) {}
8455             set arcnos($id) {}
8456             lappend seeds $id
8457         } else {
8458             set a $arcnos($id)
8459             if {[llength $olds] == 1 && [llength $a] == 1} {
8460                 lappend arcids($a) $id
8461                 if {[info exists idtags($id)]} {
8462                     lappend arctags($a) $id
8463                 }
8464                 if {[info exists idheads($id)]} {
8465                     lappend archeads($a) $id
8466                 }
8467                 if {[info exists allparents($olds)]} {
8468                     # seen parent already
8469                     if {![info exists arcout($olds)]} {
8470                         splitarc $olds
8471                     }
8472                     lappend arcids($a) $olds
8473                     set arcend($a) $olds
8474                     unset growing($a)
8475                 }
8476                 lappend allchildren($olds) $id
8477                 lappend arcnos($olds) $a
8478                 continue
8479             }
8480         }
8481         foreach a $arcnos($id) {
8482             lappend arcids($a) $id
8483             set arcend($a) $id
8484             unset growing($a)
8485         }
8486
8487         set ao {}
8488         foreach p $olds {
8489             lappend allchildren($p) $id
8490             set a [incr nextarc]
8491             set arcstart($a) $id
8492             set archeads($a) {}
8493             set arctags($a) {}
8494             set archeads($a) {}
8495             set arcids($a) {}
8496             lappend ao $a
8497             set growing($a) 1
8498             if {[info exists allparents($p)]} {
8499                 # seen it already, may need to make a new branch
8500                 if {![info exists arcout($p)]} {
8501                     splitarc $p
8502                 }
8503                 lappend arcids($a) $p
8504                 set arcend($a) $p
8505                 unset growing($a)
8506             }
8507             lappend arcnos($p) $a
8508         }
8509         set arcout($id) $ao
8510     }
8511     if {$nid > 0} {
8512         global cached_dheads cached_dtags cached_atags
8513         catch {unset cached_dheads}
8514         catch {unset cached_dtags}
8515         catch {unset cached_atags}
8516     }
8517     if {![eof $fd]} {
8518         return [expr {$nid >= 1000? 2: 1}]
8519     }
8520     set cacheok 1
8521     if {[catch {
8522         fconfigure $fd -blocking 1
8523         close $fd
8524     } err]} {
8525         # got an error reading the list of commits
8526         # if we were updating, try rereading the whole thing again
8527         if {$allcupdate} {
8528             incr allcommits -1
8529             dropcache $err
8530             return
8531         }
8532         error_popup "[mc "Error reading commit topology information;\
8533                 branch and preceding/following tag information\
8534                 will be incomplete."]\n($err)"
8535         set cacheok 0
8536     }
8537     if {[incr allcommits -1] == 0} {
8538         notbusy allcommits
8539         if {$cacheok} {
8540             run savecache
8541         }
8542     }
8543     dispneartags 0
8544     return 0
8545 }
8546
8547 proc recalcarc {a} {
8548     global arctags archeads arcids idtags idheads
8549
8550     set at {}
8551     set ah {}
8552     foreach id [lrange $arcids($a) 0 end-1] {
8553         if {[info exists idtags($id)]} {
8554             lappend at $id
8555         }
8556         if {[info exists idheads($id)]} {
8557             lappend ah $id
8558         }
8559     }
8560     set arctags($a) $at
8561     set archeads($a) $ah
8562 }
8563
8564 proc splitarc {p} {
8565     global arcnos arcids nextarc arctags archeads idtags idheads
8566     global arcstart arcend arcout allparents growing
8567
8568     set a $arcnos($p)
8569     if {[llength $a] != 1} {
8570         puts "oops splitarc called but [llength $a] arcs already"
8571         return
8572     }
8573     set a [lindex $a 0]
8574     set i [lsearch -exact $arcids($a) $p]
8575     if {$i < 0} {
8576         puts "oops splitarc $p not in arc $a"
8577         return
8578     }
8579     set na [incr nextarc]
8580     if {[info exists arcend($a)]} {
8581         set arcend($na) $arcend($a)
8582     } else {
8583         set l [lindex $allparents([lindex $arcids($a) end]) 0]
8584         set j [lsearch -exact $arcnos($l) $a]
8585         set arcnos($l) [lreplace $arcnos($l) $j $j $na]
8586     }
8587     set tail [lrange $arcids($a) [expr {$i+1}] end]
8588     set arcids($a) [lrange $arcids($a) 0 $i]
8589     set arcend($a) $p
8590     set arcstart($na) $p
8591     set arcout($p) $na
8592     set arcids($na) $tail
8593     if {[info exists growing($a)]} {
8594         set growing($na) 1
8595         unset growing($a)
8596     }
8597
8598     foreach id $tail {
8599         if {[llength $arcnos($id)] == 1} {
8600             set arcnos($id) $na
8601         } else {
8602             set j [lsearch -exact $arcnos($id) $a]
8603             set arcnos($id) [lreplace $arcnos($id) $j $j $na]
8604         }
8605     }
8606
8607     # reconstruct tags and heads lists
8608     if {$arctags($a) ne {} || $archeads($a) ne {}} {
8609         recalcarc $a
8610         recalcarc $na
8611     } else {
8612         set arctags($na) {}
8613         set archeads($na) {}
8614     }
8615 }
8616
8617 # Update things for a new commit added that is a child of one
8618 # existing commit.  Used when cherry-picking.
8619 proc addnewchild {id p} {
8620     global allparents allchildren idtags nextarc
8621     global arcnos arcids arctags arcout arcend arcstart archeads growing
8622     global seeds allcommits
8623
8624     if {![info exists allcommits] || ![info exists arcnos($p)]} return
8625     set allparents($id) [list $p]
8626     set allchildren($id) {}
8627     set arcnos($id) {}
8628     lappend seeds $id
8629     lappend allchildren($p) $id
8630     set a [incr nextarc]
8631     set arcstart($a) $id
8632     set archeads($a) {}
8633     set arctags($a) {}
8634     set arcids($a) [list $p]
8635     set arcend($a) $p
8636     if {![info exists arcout($p)]} {
8637         splitarc $p
8638     }
8639     lappend arcnos($p) $a
8640     set arcout($id) [list $a]
8641 }
8642
8643 # This implements a cache for the topology information.
8644 # The cache saves, for each arc, the start and end of the arc,
8645 # the ids on the arc, and the outgoing arcs from the end.
8646 proc readcache {f} {
8647     global arcnos arcids arcout arcstart arcend arctags archeads nextarc
8648     global idtags idheads allparents cachedarcs possible_seeds seeds growing
8649     global allcwait
8650
8651     set a $nextarc
8652     set lim $cachedarcs
8653     if {$lim - $a > 500} {
8654         set lim [expr {$a + 500}]
8655     }
8656     if {[catch {
8657         if {$a == $lim} {
8658             # finish reading the cache and setting up arctags, etc.
8659             set line [gets $f]
8660             if {$line ne "1"} {error "bad final version"}
8661             close $f
8662             foreach id [array names idtags] {
8663                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
8664                     [llength $allparents($id)] == 1} {
8665                     set a [lindex $arcnos($id) 0]
8666                     if {$arctags($a) eq {}} {
8667                         recalcarc $a
8668                     }
8669                 }
8670             }
8671             foreach id [array names idheads] {
8672                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
8673                     [llength $allparents($id)] == 1} {
8674                     set a [lindex $arcnos($id) 0]
8675                     if {$archeads($a) eq {}} {
8676                         recalcarc $a
8677                     }
8678                 }
8679             }
8680             foreach id [lsort -unique $possible_seeds] {
8681                 if {$arcnos($id) eq {}} {
8682                     lappend seeds $id
8683                 }
8684             }
8685             set allcwait 0
8686         } else {
8687             while {[incr a] <= $lim} {
8688                 set line [gets $f]
8689                 if {[llength $line] != 3} {error "bad line"}
8690                 set s [lindex $line 0]
8691                 set arcstart($a) $s
8692                 lappend arcout($s) $a
8693                 if {![info exists arcnos($s)]} {
8694                     lappend possible_seeds $s
8695                     set arcnos($s) {}
8696                 }
8697                 set e [lindex $line 1]
8698                 if {$e eq {}} {
8699                     set growing($a) 1
8700                 } else {
8701                     set arcend($a) $e
8702                     if {![info exists arcout($e)]} {
8703                         set arcout($e) {}
8704                     }
8705                 }
8706                 set arcids($a) [lindex $line 2]
8707                 foreach id $arcids($a) {
8708                     lappend allparents($s) $id
8709                     set s $id
8710                     lappend arcnos($id) $a
8711                 }
8712                 if {![info exists allparents($s)]} {
8713                     set allparents($s) {}
8714                 }
8715                 set arctags($a) {}
8716                 set archeads($a) {}
8717             }
8718             set nextarc [expr {$a - 1}]
8719         }
8720     } err]} {
8721         dropcache $err
8722         return 0
8723     }
8724     if {!$allcwait} {
8725         getallcommits
8726     }
8727     return $allcwait
8728 }
8729
8730 proc getcache {f} {
8731     global nextarc cachedarcs possible_seeds
8732
8733     if {[catch {
8734         set line [gets $f]
8735         if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
8736         # make sure it's an integer
8737         set cachedarcs [expr {int([lindex $line 1])}]
8738         if {$cachedarcs < 0} {error "bad number of arcs"}
8739         set nextarc 0
8740         set possible_seeds {}
8741         run readcache $f
8742     } err]} {
8743         dropcache $err
8744     }
8745     return 0
8746 }
8747
8748 proc dropcache {err} {
8749     global allcwait nextarc cachedarcs seeds
8750
8751     #puts "dropping cache ($err)"
8752     foreach v {arcnos arcout arcids arcstart arcend growing \
8753                    arctags archeads allparents allchildren} {
8754         global $v
8755         catch {unset $v}
8756     }
8757     set allcwait 0
8758     set nextarc 0
8759     set cachedarcs 0
8760     set seeds {}
8761     getallcommits
8762 }
8763
8764 proc writecache {f} {
8765     global cachearc cachedarcs allccache
8766     global arcstart arcend arcnos arcids arcout
8767
8768     set a $cachearc
8769     set lim $cachedarcs
8770     if {$lim - $a > 1000} {
8771         set lim [expr {$a + 1000}]
8772     }
8773     if {[catch {
8774         while {[incr a] <= $lim} {
8775             if {[info exists arcend($a)]} {
8776                 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
8777             } else {
8778                 puts $f [list $arcstart($a) {} $arcids($a)]
8779             }
8780         }
8781     } err]} {
8782         catch {close $f}
8783         catch {file delete $allccache}
8784         #puts "writing cache failed ($err)"
8785         return 0
8786     }
8787     set cachearc [expr {$a - 1}]
8788     if {$a > $cachedarcs} {
8789         puts $f "1"
8790         close $f
8791         return 0
8792     }
8793     return 1
8794 }
8795
8796 proc savecache {} {
8797     global nextarc cachedarcs cachearc allccache
8798
8799     if {$nextarc == $cachedarcs} return
8800     set cachearc 0
8801     set cachedarcs $nextarc
8802     catch {
8803         set f [open $allccache w]
8804         puts $f [list 1 $cachedarcs]
8805         run writecache $f
8806     }
8807 }
8808
8809 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
8810 # or 0 if neither is true.
8811 proc anc_or_desc {a b} {
8812     global arcout arcstart arcend arcnos cached_isanc
8813
8814     if {$arcnos($a) eq $arcnos($b)} {
8815         # Both are on the same arc(s); either both are the same BMP,
8816         # or if one is not a BMP, the other is also not a BMP or is
8817         # the BMP at end of the arc (and it only has 1 incoming arc).
8818         # Or both can be BMPs with no incoming arcs.
8819         if {$a eq $b || $arcnos($a) eq {}} {
8820             return 0
8821         }
8822         # assert {[llength $arcnos($a)] == 1}
8823         set arc [lindex $arcnos($a) 0]
8824         set i [lsearch -exact $arcids($arc) $a]
8825         set j [lsearch -exact $arcids($arc) $b]
8826         if {$i < 0 || $i > $j} {
8827             return 1
8828         } else {
8829             return -1
8830         }
8831     }
8832
8833     if {![info exists arcout($a)]} {
8834         set arc [lindex $arcnos($a) 0]
8835         if {[info exists arcend($arc)]} {
8836             set aend $arcend($arc)
8837         } else {
8838             set aend {}
8839         }
8840         set a $arcstart($arc)
8841     } else {
8842         set aend $a
8843     }
8844     if {![info exists arcout($b)]} {
8845         set arc [lindex $arcnos($b) 0]
8846         if {[info exists arcend($arc)]} {
8847             set bend $arcend($arc)
8848         } else {
8849             set bend {}
8850         }
8851         set b $arcstart($arc)
8852     } else {
8853         set bend $b
8854     }
8855     if {$a eq $bend} {
8856         return 1
8857     }
8858     if {$b eq $aend} {
8859         return -1
8860     }
8861     if {[info exists cached_isanc($a,$bend)]} {
8862         if {$cached_isanc($a,$bend)} {
8863             return 1
8864         }
8865     }
8866     if {[info exists cached_isanc($b,$aend)]} {
8867         if {$cached_isanc($b,$aend)} {
8868             return -1
8869         }
8870         if {[info exists cached_isanc($a,$bend)]} {
8871             return 0
8872         }
8873     }
8874
8875     set todo [list $a $b]
8876     set anc($a) a
8877     set anc($b) b
8878     for {set i 0} {$i < [llength $todo]} {incr i} {
8879         set x [lindex $todo $i]
8880         if {$anc($x) eq {}} {
8881             continue
8882         }
8883         foreach arc $arcnos($x) {
8884             set xd $arcstart($arc)
8885             if {$xd eq $bend} {
8886                 set cached_isanc($a,$bend) 1
8887                 set cached_isanc($b,$aend) 0
8888                 return 1
8889             } elseif {$xd eq $aend} {
8890                 set cached_isanc($b,$aend) 1
8891                 set cached_isanc($a,$bend) 0
8892                 return -1
8893             }
8894             if {![info exists anc($xd)]} {
8895                 set anc($xd) $anc($x)
8896                 lappend todo $xd
8897             } elseif {$anc($xd) ne $anc($x)} {
8898                 set anc($xd) {}
8899             }
8900         }
8901     }
8902     set cached_isanc($a,$bend) 0
8903     set cached_isanc($b,$aend) 0
8904     return 0
8905 }
8906
8907 # This identifies whether $desc has an ancestor that is
8908 # a growing tip of the graph and which is not an ancestor of $anc
8909 # and returns 0 if so and 1 if not.
8910 # If we subsequently discover a tag on such a growing tip, and that
8911 # turns out to be a descendent of $anc (which it could, since we
8912 # don't necessarily see children before parents), then $desc
8913 # isn't a good choice to display as a descendent tag of
8914 # $anc (since it is the descendent of another tag which is
8915 # a descendent of $anc).  Similarly, $anc isn't a good choice to
8916 # display as a ancestor tag of $desc.
8917 #
8918 proc is_certain {desc anc} {
8919     global arcnos arcout arcstart arcend growing problems
8920
8921     set certain {}
8922     if {[llength $arcnos($anc)] == 1} {
8923         # tags on the same arc are certain
8924         if {$arcnos($desc) eq $arcnos($anc)} {
8925             return 1
8926         }
8927         if {![info exists arcout($anc)]} {
8928             # if $anc is partway along an arc, use the start of the arc instead
8929             set a [lindex $arcnos($anc) 0]
8930             set anc $arcstart($a)
8931         }
8932     }
8933     if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
8934         set x $desc
8935     } else {
8936         set a [lindex $arcnos($desc) 0]
8937         set x $arcend($a)
8938     }
8939     if {$x == $anc} {
8940         return 1
8941     }
8942     set anclist [list $x]
8943     set dl($x) 1
8944     set nnh 1
8945     set ngrowanc 0
8946     for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
8947         set x [lindex $anclist $i]
8948         if {$dl($x)} {
8949             incr nnh -1
8950         }
8951         set done($x) 1
8952         foreach a $arcout($x) {
8953             if {[info exists growing($a)]} {
8954                 if {![info exists growanc($x)] && $dl($x)} {
8955                     set growanc($x) 1
8956                     incr ngrowanc
8957                 }
8958             } else {
8959                 set y $arcend($a)
8960                 if {[info exists dl($y)]} {
8961                     if {$dl($y)} {
8962                         if {!$dl($x)} {
8963                             set dl($y) 0
8964                             if {![info exists done($y)]} {
8965                                 incr nnh -1
8966                             }
8967                             if {[info exists growanc($x)]} {
8968                                 incr ngrowanc -1
8969                             }
8970                             set xl [list $y]
8971                             for {set k 0} {$k < [llength $xl]} {incr k} {
8972                                 set z [lindex $xl $k]
8973                                 foreach c $arcout($z) {
8974                                     if {[info exists arcend($c)]} {
8975                                         set v $arcend($c)
8976                                         if {[info exists dl($v)] && $dl($v)} {
8977                                             set dl($v) 0
8978                                             if {![info exists done($v)]} {
8979                                                 incr nnh -1
8980                                             }
8981                                             if {[info exists growanc($v)]} {
8982                                                 incr ngrowanc -1
8983                                             }
8984                                             lappend xl $v
8985                                         }
8986                                     }
8987                                 }
8988                             }
8989                         }
8990                     }
8991                 } elseif {$y eq $anc || !$dl($x)} {
8992                     set dl($y) 0
8993                     lappend anclist $y
8994                 } else {
8995                     set dl($y) 1
8996                     lappend anclist $y
8997                     incr nnh
8998                 }
8999             }
9000         }
9001     }
9002     foreach x [array names growanc] {
9003         if {$dl($x)} {
9004             return 0
9005         }
9006         return 0
9007     }
9008     return 1
9009 }
9010
9011 proc validate_arctags {a} {
9012     global arctags idtags
9013
9014     set i -1
9015     set na $arctags($a)
9016     foreach id $arctags($a) {
9017         incr i
9018         if {![info exists idtags($id)]} {
9019             set na [lreplace $na $i $i]
9020             incr i -1
9021         }
9022     }
9023     set arctags($a) $na
9024 }
9025
9026 proc validate_archeads {a} {
9027     global archeads idheads
9028
9029     set i -1
9030     set na $archeads($a)
9031     foreach id $archeads($a) {
9032         incr i
9033         if {![info exists idheads($id)]} {
9034             set na [lreplace $na $i $i]
9035             incr i -1
9036         }
9037     }
9038     set archeads($a) $na
9039 }
9040
9041 # Return the list of IDs that have tags that are descendents of id,
9042 # ignoring IDs that are descendents of IDs already reported.
9043 proc desctags {id} {
9044     global arcnos arcstart arcids arctags idtags allparents
9045     global growing cached_dtags
9046
9047     if {![info exists allparents($id)]} {
9048         return {}
9049     }
9050     set t1 [clock clicks -milliseconds]
9051     set argid $id
9052     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9053         # part-way along an arc; check that arc first
9054         set a [lindex $arcnos($id) 0]
9055         if {$arctags($a) ne {}} {
9056             validate_arctags $a
9057             set i [lsearch -exact $arcids($a) $id]
9058             set tid {}
9059             foreach t $arctags($a) {
9060                 set j [lsearch -exact $arcids($a) $t]
9061                 if {$j >= $i} break
9062                 set tid $t
9063             }
9064             if {$tid ne {}} {
9065                 return $tid
9066             }
9067         }
9068         set id $arcstart($a)
9069         if {[info exists idtags($id)]} {
9070             return $id
9071         }
9072     }
9073     if {[info exists cached_dtags($id)]} {
9074         return $cached_dtags($id)
9075     }
9076
9077     set origid $id
9078     set todo [list $id]
9079     set queued($id) 1
9080     set nc 1
9081     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
9082         set id [lindex $todo $i]
9083         set done($id) 1
9084         set ta [info exists hastaggedancestor($id)]
9085         if {!$ta} {
9086             incr nc -1
9087         }
9088         # ignore tags on starting node
9089         if {!$ta && $i > 0} {
9090             if {[info exists idtags($id)]} {
9091                 set tagloc($id) $id
9092                 set ta 1
9093             } elseif {[info exists cached_dtags($id)]} {
9094                 set tagloc($id) $cached_dtags($id)
9095                 set ta 1
9096             }
9097         }
9098         foreach a $arcnos($id) {
9099             set d $arcstart($a)
9100             if {!$ta && $arctags($a) ne {}} {
9101                 validate_arctags $a
9102                 if {$arctags($a) ne {}} {
9103                     lappend tagloc($id) [lindex $arctags($a) end]
9104                 }
9105             }
9106             if {$ta || $arctags($a) ne {}} {
9107                 set tomark [list $d]
9108                 for {set j 0} {$j < [llength $tomark]} {incr j} {
9109                     set dd [lindex $tomark $j]
9110                     if {![info exists hastaggedancestor($dd)]} {
9111                         if {[info exists done($dd)]} {
9112                             foreach b $arcnos($dd) {
9113                                 lappend tomark $arcstart($b)
9114                             }
9115                             if {[info exists tagloc($dd)]} {
9116                                 unset tagloc($dd)
9117                             }
9118                         } elseif {[info exists queued($dd)]} {
9119                             incr nc -1
9120                         }
9121                         set hastaggedancestor($dd) 1
9122                     }
9123                 }
9124             }
9125             if {![info exists queued($d)]} {
9126                 lappend todo $d
9127                 set queued($d) 1
9128                 if {![info exists hastaggedancestor($d)]} {
9129                     incr nc
9130                 }
9131             }
9132         }
9133     }
9134     set tags {}
9135     foreach id [array names tagloc] {
9136         if {![info exists hastaggedancestor($id)]} {
9137             foreach t $tagloc($id) {
9138                 if {[lsearch -exact $tags $t] < 0} {
9139                     lappend tags $t
9140                 }
9141             }
9142         }
9143     }
9144     set t2 [clock clicks -milliseconds]
9145     set loopix $i
9146
9147     # remove tags that are descendents of other tags
9148     for {set i 0} {$i < [llength $tags]} {incr i} {
9149         set a [lindex $tags $i]
9150         for {set j 0} {$j < $i} {incr j} {
9151             set b [lindex $tags $j]
9152             set r [anc_or_desc $a $b]
9153             if {$r == 1} {
9154                 set tags [lreplace $tags $j $j]
9155                 incr j -1
9156                 incr i -1
9157             } elseif {$r == -1} {
9158                 set tags [lreplace $tags $i $i]
9159                 incr i -1
9160                 break
9161             }
9162         }
9163     }
9164
9165     if {[array names growing] ne {}} {
9166         # graph isn't finished, need to check if any tag could get
9167         # eclipsed by another tag coming later.  Simply ignore any
9168         # tags that could later get eclipsed.
9169         set ctags {}
9170         foreach t $tags {
9171             if {[is_certain $t $origid]} {
9172                 lappend ctags $t
9173             }
9174         }
9175         if {$tags eq $ctags} {
9176             set cached_dtags($origid) $tags
9177         } else {
9178             set tags $ctags
9179         }
9180     } else {
9181         set cached_dtags($origid) $tags
9182     }
9183     set t3 [clock clicks -milliseconds]
9184     if {0 && $t3 - $t1 >= 100} {
9185         puts "iterating descendents ($loopix/[llength $todo] nodes) took\
9186             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
9187     }
9188     return $tags
9189 }
9190
9191 proc anctags {id} {
9192     global arcnos arcids arcout arcend arctags idtags allparents
9193     global growing cached_atags
9194
9195     if {![info exists allparents($id)]} {
9196         return {}
9197     }
9198     set t1 [clock clicks -milliseconds]
9199     set argid $id
9200     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9201         # part-way along an arc; check that arc first
9202         set a [lindex $arcnos($id) 0]
9203         if {$arctags($a) ne {}} {
9204             validate_arctags $a
9205             set i [lsearch -exact $arcids($a) $id]
9206             foreach t $arctags($a) {
9207                 set j [lsearch -exact $arcids($a) $t]
9208                 if {$j > $i} {
9209                     return $t
9210                 }
9211             }
9212         }
9213         if {![info exists arcend($a)]} {
9214             return {}
9215         }
9216         set id $arcend($a)
9217         if {[info exists idtags($id)]} {
9218             return $id
9219         }
9220     }
9221     if {[info exists cached_atags($id)]} {
9222         return $cached_atags($id)
9223     }
9224
9225     set origid $id
9226     set todo [list $id]
9227     set queued($id) 1
9228     set taglist {}
9229     set nc 1
9230     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
9231         set id [lindex $todo $i]
9232         set done($id) 1
9233         set td [info exists hastaggeddescendent($id)]
9234         if {!$td} {
9235             incr nc -1
9236         }
9237         # ignore tags on starting node
9238         if {!$td && $i > 0} {
9239             if {[info exists idtags($id)]} {
9240                 set tagloc($id) $id
9241                 set td 1
9242             } elseif {[info exists cached_atags($id)]} {
9243                 set tagloc($id) $cached_atags($id)
9244                 set td 1
9245             }
9246         }
9247         foreach a $arcout($id) {
9248             if {!$td && $arctags($a) ne {}} {
9249                 validate_arctags $a
9250                 if {$arctags($a) ne {}} {
9251                     lappend tagloc($id) [lindex $arctags($a) 0]
9252                 }
9253             }
9254             if {![info exists arcend($a)]} continue
9255             set d $arcend($a)
9256             if {$td || $arctags($a) ne {}} {
9257                 set tomark [list $d]
9258                 for {set j 0} {$j < [llength $tomark]} {incr j} {
9259                     set dd [lindex $tomark $j]
9260                     if {![info exists hastaggeddescendent($dd)]} {
9261                         if {[info exists done($dd)]} {
9262                             foreach b $arcout($dd) {
9263                                 if {[info exists arcend($b)]} {
9264                                     lappend tomark $arcend($b)
9265                                 }
9266                             }
9267                             if {[info exists tagloc($dd)]} {
9268                                 unset tagloc($dd)
9269                             }
9270                         } elseif {[info exists queued($dd)]} {
9271                             incr nc -1
9272                         }
9273                         set hastaggeddescendent($dd) 1
9274                     }
9275                 }
9276             }
9277             if {![info exists queued($d)]} {
9278                 lappend todo $d
9279                 set queued($d) 1
9280                 if {![info exists hastaggeddescendent($d)]} {
9281                     incr nc
9282                 }
9283             }
9284         }
9285     }
9286     set t2 [clock clicks -milliseconds]
9287     set loopix $i
9288     set tags {}
9289     foreach id [array names tagloc] {
9290         if {![info exists hastaggeddescendent($id)]} {
9291             foreach t $tagloc($id) {
9292                 if {[lsearch -exact $tags $t] < 0} {
9293                     lappend tags $t
9294                 }
9295             }
9296         }
9297     }
9298
9299     # remove tags that are ancestors of other tags
9300     for {set i 0} {$i < [llength $tags]} {incr i} {
9301         set a [lindex $tags $i]
9302         for {set j 0} {$j < $i} {incr j} {
9303             set b [lindex $tags $j]
9304             set r [anc_or_desc $a $b]
9305             if {$r == -1} {
9306                 set tags [lreplace $tags $j $j]
9307                 incr j -1
9308                 incr i -1
9309             } elseif {$r == 1} {
9310                 set tags [lreplace $tags $i $i]
9311                 incr i -1
9312                 break
9313             }
9314         }
9315     }
9316
9317     if {[array names growing] ne {}} {
9318         # graph isn't finished, need to check if any tag could get
9319         # eclipsed by another tag coming later.  Simply ignore any
9320         # tags that could later get eclipsed.
9321         set ctags {}
9322         foreach t $tags {
9323             if {[is_certain $origid $t]} {
9324                 lappend ctags $t
9325             }
9326         }
9327         if {$tags eq $ctags} {
9328             set cached_atags($origid) $tags
9329         } else {
9330             set tags $ctags
9331         }
9332     } else {
9333         set cached_atags($origid) $tags
9334     }
9335     set t3 [clock clicks -milliseconds]
9336     if {0 && $t3 - $t1 >= 100} {
9337         puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
9338             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
9339     }
9340     return $tags
9341 }
9342
9343 # Return the list of IDs that have heads that are descendents of id,
9344 # including id itself if it has a head.
9345 proc descheads {id} {
9346     global arcnos arcstart arcids archeads idheads cached_dheads
9347     global allparents
9348
9349     if {![info exists allparents($id)]} {
9350         return {}
9351     }
9352     set aret {}
9353     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9354         # part-way along an arc; check it first
9355         set a [lindex $arcnos($id) 0]
9356         if {$archeads($a) ne {}} {
9357             validate_archeads $a
9358             set i [lsearch -exact $arcids($a) $id]
9359             foreach t $archeads($a) {
9360                 set j [lsearch -exact $arcids($a) $t]
9361                 if {$j > $i} break
9362                 lappend aret $t
9363             }
9364         }
9365         set id $arcstart($a)
9366     }
9367     set origid $id
9368     set todo [list $id]
9369     set seen($id) 1
9370     set ret {}
9371     for {set i 0} {$i < [llength $todo]} {incr i} {
9372         set id [lindex $todo $i]
9373         if {[info exists cached_dheads($id)]} {
9374             set ret [concat $ret $cached_dheads($id)]
9375         } else {
9376             if {[info exists idheads($id)]} {
9377                 lappend ret $id
9378             }
9379             foreach a $arcnos($id) {
9380                 if {$archeads($a) ne {}} {
9381                     validate_archeads $a
9382                     if {$archeads($a) ne {}} {
9383                         set ret [concat $ret $archeads($a)]
9384                     }
9385                 }
9386                 set d $arcstart($a)
9387                 if {![info exists seen($d)]} {
9388                     lappend todo $d
9389                     set seen($d) 1
9390                 }
9391             }
9392         }
9393     }
9394     set ret [lsort -unique $ret]
9395     set cached_dheads($origid) $ret
9396     return [concat $ret $aret]
9397 }
9398
9399 proc addedtag {id} {
9400     global arcnos arcout cached_dtags cached_atags
9401
9402     if {![info exists arcnos($id)]} return
9403     if {![info exists arcout($id)]} {
9404         recalcarc [lindex $arcnos($id) 0]
9405     }
9406     catch {unset cached_dtags}
9407     catch {unset cached_atags}
9408 }
9409
9410 proc addedhead {hid head} {
9411     global arcnos arcout cached_dheads
9412
9413     if {![info exists arcnos($hid)]} return
9414     if {![info exists arcout($hid)]} {
9415         recalcarc [lindex $arcnos($hid) 0]
9416     }
9417     catch {unset cached_dheads}
9418 }
9419
9420 proc removedhead {hid head} {
9421     global cached_dheads
9422
9423     catch {unset cached_dheads}
9424 }
9425
9426 proc movedhead {hid head} {
9427     global arcnos arcout cached_dheads
9428
9429     if {![info exists arcnos($hid)]} return
9430     if {![info exists arcout($hid)]} {
9431         recalcarc [lindex $arcnos($hid) 0]
9432     }
9433     catch {unset cached_dheads}
9434 }
9435
9436 proc changedrefs {} {
9437     global cached_dheads cached_dtags cached_atags
9438     global arctags archeads arcnos arcout idheads idtags
9439
9440     foreach id [concat [array names idheads] [array names idtags]] {
9441         if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
9442             set a [lindex $arcnos($id) 0]
9443             if {![info exists donearc($a)]} {
9444                 recalcarc $a
9445                 set donearc($a) 1
9446             }
9447         }
9448     }
9449     catch {unset cached_dtags}
9450     catch {unset cached_atags}
9451     catch {unset cached_dheads}
9452 }
9453
9454 proc rereadrefs {} {
9455     global idtags idheads idotherrefs mainheadid
9456
9457     set refids [concat [array names idtags] \
9458                     [array names idheads] [array names idotherrefs]]
9459     foreach id $refids {
9460         if {![info exists ref($id)]} {
9461             set ref($id) [listrefs $id]
9462         }
9463     }
9464     set oldmainhead $mainheadid
9465     readrefs
9466     changedrefs
9467     set refids [lsort -unique [concat $refids [array names idtags] \
9468                         [array names idheads] [array names idotherrefs]]]
9469     foreach id $refids {
9470         set v [listrefs $id]
9471         if {![info exists ref($id)] || $ref($id) != $v} {
9472             redrawtags $id
9473         }
9474     }
9475     if {$oldmainhead ne $mainheadid} {
9476         redrawtags $oldmainhead
9477         redrawtags $mainheadid
9478     }
9479     run refill_reflist
9480 }
9481
9482 proc listrefs {id} {
9483     global idtags idheads idotherrefs
9484
9485     set x {}
9486     if {[info exists idtags($id)]} {
9487         set x $idtags($id)
9488     }
9489     set y {}
9490     if {[info exists idheads($id)]} {
9491         set y $idheads($id)
9492     }
9493     set z {}
9494     if {[info exists idotherrefs($id)]} {
9495         set z $idotherrefs($id)
9496     }
9497     return [list $x $y $z]
9498 }
9499
9500 proc showtag {tag isnew} {
9501     global ctext tagcontents tagids linknum tagobjid
9502
9503     if {$isnew} {
9504         addtohistory [list showtag $tag 0]
9505     }
9506     $ctext conf -state normal
9507     clear_ctext
9508     settabs 0
9509     set linknum 0
9510     if {![info exists tagcontents($tag)]} {
9511         catch {
9512             set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
9513         }
9514     }
9515     if {[info exists tagcontents($tag)]} {
9516         set text $tagcontents($tag)
9517     } else {
9518         set text "[mc "Tag"]: $tag\n[mc "Id"]:  $tagids($tag)"
9519     }
9520     appendwithlinks $text {}
9521     $ctext conf -state disabled
9522     init_flist {}
9523 }
9524
9525 proc doquit {} {
9526     global stopped
9527     global gitktmpdir
9528
9529     set stopped 100
9530     savestuff .
9531     destroy .
9532
9533     if {[info exists gitktmpdir]} {
9534         catch {file delete -force $gitktmpdir}
9535     }
9536 }
9537
9538 proc mkfontdisp {font top which} {
9539     global fontattr fontpref $font
9540
9541     set fontpref($font) [set $font]
9542     button $top.${font}but -text $which -font optionfont \
9543         -command [list choosefont $font $which]
9544     label $top.$font -relief flat -font $font \
9545         -text $fontattr($font,family) -justify left
9546     grid x $top.${font}but $top.$font -sticky w
9547 }
9548
9549 proc choosefont {font which} {
9550     global fontparam fontlist fonttop fontattr
9551
9552     set fontparam(which) $which
9553     set fontparam(font) $font
9554     set fontparam(family) [font actual $font -family]
9555     set fontparam(size) $fontattr($font,size)
9556     set fontparam(weight) $fontattr($font,weight)
9557     set fontparam(slant) $fontattr($font,slant)
9558     set top .gitkfont
9559     set fonttop $top
9560     if {![winfo exists $top]} {
9561         font create sample
9562         eval font config sample [font actual $font]
9563         toplevel $top
9564         wm title $top [mc "Gitk font chooser"]
9565         label $top.l -textvariable fontparam(which)
9566         pack $top.l -side top
9567         set fontlist [lsort [font families]]
9568         frame $top.f
9569         listbox $top.f.fam -listvariable fontlist \
9570             -yscrollcommand [list $top.f.sb set]
9571         bind $top.f.fam <<ListboxSelect>> selfontfam
9572         scrollbar $top.f.sb -command [list $top.f.fam yview]
9573         pack $top.f.sb -side right -fill y
9574         pack $top.f.fam -side left -fill both -expand 1
9575         pack $top.f -side top -fill both -expand 1
9576         frame $top.g
9577         spinbox $top.g.size -from 4 -to 40 -width 4 \
9578             -textvariable fontparam(size) \
9579             -validatecommand {string is integer -strict %s}
9580         checkbutton $top.g.bold -padx 5 \
9581             -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
9582             -variable fontparam(weight) -onvalue bold -offvalue normal
9583         checkbutton $top.g.ital -padx 5 \
9584             -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
9585             -variable fontparam(slant) -onvalue italic -offvalue roman
9586         pack $top.g.size $top.g.bold $top.g.ital -side left
9587         pack $top.g -side top
9588         canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
9589             -background white
9590         $top.c create text 100 25 -anchor center -text $which -font sample \
9591             -fill black -tags text
9592         bind $top.c <Configure> [list centertext $top.c]
9593         pack $top.c -side top -fill x
9594         frame $top.buts
9595         button $top.buts.ok -text [mc "OK"] -command fontok -default active
9596         button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
9597         grid $top.buts.ok $top.buts.can
9598         grid columnconfigure $top.buts 0 -weight 1 -uniform a
9599         grid columnconfigure $top.buts 1 -weight 1 -uniform a
9600         pack $top.buts -side bottom -fill x
9601         trace add variable fontparam write chg_fontparam
9602     } else {
9603         raise $top
9604         $top.c itemconf text -text $which
9605     }
9606     set i [lsearch -exact $fontlist $fontparam(family)]
9607     if {$i >= 0} {
9608         $top.f.fam selection set $i
9609         $top.f.fam see $i
9610     }
9611 }
9612
9613 proc centertext {w} {
9614     $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
9615 }
9616
9617 proc fontok {} {
9618     global fontparam fontpref prefstop
9619
9620     set f $fontparam(font)
9621     set fontpref($f) [list $fontparam(family) $fontparam(size)]
9622     if {$fontparam(weight) eq "bold"} {
9623         lappend fontpref($f) "bold"
9624     }
9625     if {$fontparam(slant) eq "italic"} {
9626         lappend fontpref($f) "italic"
9627     }
9628     set w $prefstop.$f
9629     $w conf -text $fontparam(family) -font $fontpref($f)
9630
9631     fontcan
9632 }
9633
9634 proc fontcan {} {
9635     global fonttop fontparam
9636
9637     if {[info exists fonttop]} {
9638         catch {destroy $fonttop}
9639         catch {font delete sample}
9640         unset fonttop
9641         unset fontparam
9642     }
9643 }
9644
9645 proc selfontfam {} {
9646     global fonttop fontparam
9647
9648     set i [$fonttop.f.fam curselection]
9649     if {$i ne {}} {
9650         set fontparam(family) [$fonttop.f.fam get $i]
9651     }
9652 }
9653
9654 proc chg_fontparam {v sub op} {
9655     global fontparam
9656
9657     font config sample -$sub $fontparam($sub)
9658 }
9659
9660 proc doprefs {} {
9661     global maxwidth maxgraphpct
9662     global oldprefs prefstop showneartags showlocalchanges
9663     global bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
9664     global tabstop limitdiffs autoselect extdifftool perfile_attrs
9665
9666     set top .gitkprefs
9667     set prefstop $top
9668     if {[winfo exists $top]} {
9669         raise $top
9670         return
9671     }
9672     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
9673                    limitdiffs tabstop perfile_attrs} {
9674         set oldprefs($v) [set $v]
9675     }
9676     toplevel $top
9677     wm title $top [mc "Gitk preferences"]
9678     label $top.ldisp -text [mc "Commit list display options"]
9679     grid $top.ldisp - -sticky w -pady 10
9680     label $top.spacer -text " "
9681     label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
9682         -font optionfont
9683     spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
9684     grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
9685     label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
9686         -font optionfont
9687     spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
9688     grid x $top.maxpctl $top.maxpct -sticky w
9689     frame $top.showlocal
9690     label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
9691     checkbutton $top.showlocal.b -variable showlocalchanges
9692     pack $top.showlocal.b $top.showlocal.l -side left
9693     grid x $top.showlocal -sticky w
9694     frame $top.autoselect
9695     label $top.autoselect.l -text [mc "Auto-select SHA1"] -font optionfont
9696     checkbutton $top.autoselect.b -variable autoselect
9697     pack $top.autoselect.b $top.autoselect.l -side left
9698     grid x $top.autoselect -sticky w
9699
9700     label $top.ddisp -text [mc "Diff display options"]
9701     grid $top.ddisp - -sticky w -pady 10
9702     label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
9703     spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
9704     grid x $top.tabstopl $top.tabstop -sticky w
9705     frame $top.ntag
9706     label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
9707     checkbutton $top.ntag.b -variable showneartags
9708     pack $top.ntag.b $top.ntag.l -side left
9709     grid x $top.ntag -sticky w
9710     frame $top.ldiff
9711     label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
9712     checkbutton $top.ldiff.b -variable limitdiffs
9713     pack $top.ldiff.b $top.ldiff.l -side left
9714     grid x $top.ldiff -sticky w
9715     frame $top.lattr
9716     label $top.lattr.l -text [mc "Support per-file encodings"] -font optionfont
9717     checkbutton $top.lattr.b -variable perfile_attrs
9718     pack $top.lattr.b $top.lattr.l -side left
9719     grid x $top.lattr -sticky w
9720
9721     entry $top.extdifft -textvariable extdifftool
9722     frame $top.extdifff
9723     label $top.extdifff.l -text [mc "External diff tool" ] -font optionfont \
9724         -padx 10
9725     button $top.extdifff.b -text [mc "Choose..."] -font optionfont \
9726         -command choose_extdiff
9727     pack $top.extdifff.l $top.extdifff.b -side left
9728     grid x $top.extdifff $top.extdifft -sticky w
9729
9730     label $top.cdisp -text [mc "Colors: press to choose"]
9731     grid $top.cdisp - -sticky w -pady 10
9732     label $top.bg -padx 40 -relief sunk -background $bgcolor
9733     button $top.bgbut -text [mc "Background"] -font optionfont \
9734         -command [list choosecolor bgcolor {} $top.bg background setbg]
9735     grid x $top.bgbut $top.bg -sticky w
9736     label $top.fg -padx 40 -relief sunk -background $fgcolor
9737     button $top.fgbut -text [mc "Foreground"] -font optionfont \
9738         -command [list choosecolor fgcolor {} $top.fg foreground setfg]
9739     grid x $top.fgbut $top.fg -sticky w
9740     label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
9741     button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
9742         -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
9743                       [list $ctext tag conf d0 -foreground]]
9744     grid x $top.diffoldbut $top.diffold -sticky w
9745     label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
9746     button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
9747         -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
9748                       [list $ctext tag conf dresult -foreground]]
9749     grid x $top.diffnewbut $top.diffnew -sticky w
9750     label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
9751     button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
9752         -command [list choosecolor diffcolors 2 $top.hunksep \
9753                       "diff hunk header" \
9754                       [list $ctext tag conf hunksep -foreground]]
9755     grid x $top.hunksepbut $top.hunksep -sticky w
9756     label $top.markbgsep -padx 40 -relief sunk -background $markbgcolor
9757     button $top.markbgbut -text [mc "Marked line bg"] -font optionfont \
9758         -command [list choosecolor markbgcolor {} $top.markbgsep \
9759                       [mc "marked line background"] \
9760                       [list $ctext tag conf omark -background]]
9761     grid x $top.markbgbut $top.markbgsep -sticky w
9762     label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
9763     button $top.selbgbut -text [mc "Select bg"] -font optionfont \
9764         -command [list choosecolor selectbgcolor {} $top.selbgsep background setselbg]
9765     grid x $top.selbgbut $top.selbgsep -sticky w
9766
9767     label $top.cfont -text [mc "Fonts: press to choose"]
9768     grid $top.cfont - -sticky w -pady 10
9769     mkfontdisp mainfont $top [mc "Main font"]
9770     mkfontdisp textfont $top [mc "Diff display font"]
9771     mkfontdisp uifont $top [mc "User interface font"]
9772
9773     frame $top.buts
9774     button $top.buts.ok -text [mc "OK"] -command prefsok -default active
9775     button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
9776     grid $top.buts.ok $top.buts.can
9777     grid columnconfigure $top.buts 0 -weight 1 -uniform a
9778     grid columnconfigure $top.buts 1 -weight 1 -uniform a
9779     grid $top.buts - - -pady 10 -sticky ew
9780     bind $top <Visibility> "focus $top.buts.ok"
9781 }
9782
9783 proc choose_extdiff {} {
9784     global extdifftool
9785
9786     set prog [tk_getOpenFile -title "External diff tool" -multiple false]
9787     if {$prog ne {}} {
9788         set extdifftool $prog
9789     }
9790 }
9791
9792 proc choosecolor {v vi w x cmd} {
9793     global $v
9794
9795     set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
9796                -title [mc "Gitk: choose color for %s" $x]]
9797     if {$c eq {}} return
9798     $w conf -background $c
9799     lset $v $vi $c
9800     eval $cmd $c
9801 }
9802
9803 proc setselbg {c} {
9804     global bglist cflist
9805     foreach w $bglist {
9806         $w configure -selectbackground $c
9807     }
9808     $cflist tag configure highlight \
9809         -background [$cflist cget -selectbackground]
9810     allcanvs itemconf secsel -fill $c
9811 }
9812
9813 proc setbg {c} {
9814     global bglist
9815
9816     foreach w $bglist {
9817         $w conf -background $c
9818     }
9819 }
9820
9821 proc setfg {c} {
9822     global fglist canv
9823
9824     foreach w $fglist {
9825         $w conf -foreground $c
9826     }
9827     allcanvs itemconf text -fill $c
9828     $canv itemconf circle -outline $c
9829 }
9830
9831 proc prefscan {} {
9832     global oldprefs prefstop
9833
9834     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
9835                    limitdiffs tabstop perfile_attrs} {
9836         global $v
9837         set $v $oldprefs($v)
9838     }
9839     catch {destroy $prefstop}
9840     unset prefstop
9841     fontcan
9842 }
9843
9844 proc prefsok {} {
9845     global maxwidth maxgraphpct
9846     global oldprefs prefstop showneartags showlocalchanges
9847     global fontpref mainfont textfont uifont
9848     global limitdiffs treediffs perfile_attrs
9849
9850     catch {destroy $prefstop}
9851     unset prefstop
9852     fontcan
9853     set fontchanged 0
9854     if {$mainfont ne $fontpref(mainfont)} {
9855         set mainfont $fontpref(mainfont)
9856         parsefont mainfont $mainfont
9857         eval font configure mainfont [fontflags mainfont]
9858         eval font configure mainfontbold [fontflags mainfont 1]
9859         setcoords
9860         set fontchanged 1
9861     }
9862     if {$textfont ne $fontpref(textfont)} {
9863         set textfont $fontpref(textfont)
9864         parsefont textfont $textfont
9865         eval font configure textfont [fontflags textfont]
9866         eval font configure textfontbold [fontflags textfont 1]
9867     }
9868     if {$uifont ne $fontpref(uifont)} {
9869         set uifont $fontpref(uifont)
9870         parsefont uifont $uifont
9871         eval font configure uifont [fontflags uifont]
9872     }
9873     settabs
9874     if {$showlocalchanges != $oldprefs(showlocalchanges)} {
9875         if {$showlocalchanges} {
9876             doshowlocalchanges
9877         } else {
9878             dohidelocalchanges
9879         }
9880     }
9881     if {$limitdiffs != $oldprefs(limitdiffs) ||
9882         ($perfile_attrs && !$oldprefs(perfile_attrs))} {
9883         # treediffs elements are limited by path;
9884         # won't have encodings cached if perfile_attrs was just turned on
9885         catch {unset treediffs}
9886     }
9887     if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
9888         || $maxgraphpct != $oldprefs(maxgraphpct)} {
9889         redisplay
9890     } elseif {$showneartags != $oldprefs(showneartags) ||
9891           $limitdiffs != $oldprefs(limitdiffs)} {
9892         reselectline
9893     }
9894 }
9895
9896 proc formatdate {d} {
9897     global datetimeformat
9898     if {$d ne {}} {
9899         set d [clock format $d -format $datetimeformat]
9900     }
9901     return $d
9902 }
9903
9904 # This list of encoding names and aliases is distilled from
9905 # http://www.iana.org/assignments/character-sets.
9906 # Not all of them are supported by Tcl.
9907 set encoding_aliases {
9908     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
9909       ISO646-US US-ASCII us IBM367 cp367 csASCII }
9910     { ISO-10646-UTF-1 csISO10646UTF1 }
9911     { ISO_646.basic:1983 ref csISO646basic1983 }
9912     { INVARIANT csINVARIANT }
9913     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
9914     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
9915     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
9916     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
9917     { NATS-DANO iso-ir-9-1 csNATSDANO }
9918     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
9919     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
9920     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
9921     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
9922     { ISO-2022-KR csISO2022KR }
9923     { EUC-KR csEUCKR }
9924     { ISO-2022-JP csISO2022JP }
9925     { ISO-2022-JP-2 csISO2022JP2 }
9926     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
9927       csISO13JISC6220jp }
9928     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
9929     { IT iso-ir-15 ISO646-IT csISO15Italian }
9930     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
9931     { ES iso-ir-17 ISO646-ES csISO17Spanish }
9932     { greek7-old iso-ir-18 csISO18Greek7Old }
9933     { latin-greek iso-ir-19 csISO19LatinGreek }
9934     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
9935     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
9936     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
9937     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
9938     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
9939     { BS_viewdata iso-ir-47 csISO47BSViewdata }
9940     { INIS iso-ir-49 csISO49INIS }
9941     { INIS-8 iso-ir-50 csISO50INIS8 }
9942     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
9943     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
9944     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
9945     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
9946     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
9947     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
9948       csISO60Norwegian1 }
9949     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
9950     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
9951     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
9952     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
9953     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
9954     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
9955     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
9956     { greek7 iso-ir-88 csISO88Greek7 }
9957     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
9958     { iso-ir-90 csISO90 }
9959     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
9960     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
9961       csISO92JISC62991984b }
9962     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
9963     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
9964     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
9965       csISO95JIS62291984handadd }
9966     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
9967     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
9968     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
9969     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
9970       CP819 csISOLatin1 }
9971     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
9972     { T.61-7bit iso-ir-102 csISO102T617bit }
9973     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
9974     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
9975     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
9976     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
9977     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
9978     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
9979     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
9980     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
9981       arabic csISOLatinArabic }
9982     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
9983     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
9984     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
9985       greek greek8 csISOLatinGreek }
9986     { T.101-G2 iso-ir-128 csISO128T101G2 }
9987     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
9988       csISOLatinHebrew }
9989     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
9990     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
9991     { CSN_369103 iso-ir-139 csISO139CSN369103 }
9992     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
9993     { ISO_6937-2-add iso-ir-142 csISOTextComm }
9994     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
9995     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
9996       csISOLatinCyrillic }
9997     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
9998     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
9999     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
10000     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
10001     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
10002     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
10003     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
10004     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
10005     { ISO_10367-box iso-ir-155 csISO10367Box }
10006     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
10007     { latin-lap lap iso-ir-158 csISO158Lap }
10008     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
10009     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
10010     { us-dk csUSDK }
10011     { dk-us csDKUS }
10012     { JIS_X0201 X0201 csHalfWidthKatakana }
10013     { KSC5636 ISO646-KR csKSC5636 }
10014     { ISO-10646-UCS-2 csUnicode }
10015     { ISO-10646-UCS-4 csUCS4 }
10016     { DEC-MCS dec csDECMCS }
10017     { hp-roman8 roman8 r8 csHPRoman8 }
10018     { macintosh mac csMacintosh }
10019     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
10020       csIBM037 }
10021     { IBM038 EBCDIC-INT cp038 csIBM038 }
10022     { IBM273 CP273 csIBM273 }
10023     { IBM274 EBCDIC-BE CP274 csIBM274 }
10024     { IBM275 EBCDIC-BR cp275 csIBM275 }
10025     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
10026     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
10027     { IBM280 CP280 ebcdic-cp-it csIBM280 }
10028     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
10029     { IBM284 CP284 ebcdic-cp-es csIBM284 }
10030     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
10031     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
10032     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
10033     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
10034     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
10035     { IBM424 cp424 ebcdic-cp-he csIBM424 }
10036     { IBM437 cp437 437 csPC8CodePage437 }
10037     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
10038     { IBM775 cp775 csPC775Baltic }
10039     { IBM850 cp850 850 csPC850Multilingual }
10040     { IBM851 cp851 851 csIBM851 }
10041     { IBM852 cp852 852 csPCp852 }
10042     { IBM855 cp855 855 csIBM855 }
10043     { IBM857 cp857 857 csIBM857 }
10044     { IBM860 cp860 860 csIBM860 }
10045     { IBM861 cp861 861 cp-is csIBM861 }
10046     { IBM862 cp862 862 csPC862LatinHebrew }
10047     { IBM863 cp863 863 csIBM863 }
10048     { IBM864 cp864 csIBM864 }
10049     { IBM865 cp865 865 csIBM865 }
10050     { IBM866 cp866 866 csIBM866 }
10051     { IBM868 CP868 cp-ar csIBM868 }
10052     { IBM869 cp869 869 cp-gr csIBM869 }
10053     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
10054     { IBM871 CP871 ebcdic-cp-is csIBM871 }
10055     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
10056     { IBM891 cp891 csIBM891 }
10057     { IBM903 cp903 csIBM903 }
10058     { IBM904 cp904 904 csIBBM904 }
10059     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
10060     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
10061     { IBM1026 CP1026 csIBM1026 }
10062     { EBCDIC-AT-DE csIBMEBCDICATDE }
10063     { EBCDIC-AT-DE-A csEBCDICATDEA }
10064     { EBCDIC-CA-FR csEBCDICCAFR }
10065     { EBCDIC-DK-NO csEBCDICDKNO }
10066     { EBCDIC-DK-NO-A csEBCDICDKNOA }
10067     { EBCDIC-FI-SE csEBCDICFISE }
10068     { EBCDIC-FI-SE-A csEBCDICFISEA }
10069     { EBCDIC-FR csEBCDICFR }
10070     { EBCDIC-IT csEBCDICIT }
10071     { EBCDIC-PT csEBCDICPT }
10072     { EBCDIC-ES csEBCDICES }
10073     { EBCDIC-ES-A csEBCDICESA }
10074     { EBCDIC-ES-S csEBCDICESS }
10075     { EBCDIC-UK csEBCDICUK }
10076     { EBCDIC-US csEBCDICUS }
10077     { UNKNOWN-8BIT csUnknown8BiT }
10078     { MNEMONIC csMnemonic }
10079     { MNEM csMnem }
10080     { VISCII csVISCII }
10081     { VIQR csVIQR }
10082     { KOI8-R csKOI8R }
10083     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
10084     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
10085     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
10086     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
10087     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
10088     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
10089     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
10090     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
10091     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
10092     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
10093     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
10094     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
10095     { IBM1047 IBM-1047 }
10096     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
10097     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
10098     { UNICODE-1-1 csUnicode11 }
10099     { CESU-8 csCESU-8 }
10100     { BOCU-1 csBOCU-1 }
10101     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
10102     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
10103       l8 }
10104     { ISO-8859-15 ISO_8859-15 Latin-9 }
10105     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
10106     { GBK CP936 MS936 windows-936 }
10107     { JIS_Encoding csJISEncoding }
10108     { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
10109     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
10110       EUC-JP }
10111     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
10112     { ISO-10646-UCS-Basic csUnicodeASCII }
10113     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
10114     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
10115     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
10116     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
10117     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
10118     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
10119     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
10120     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
10121     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
10122     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
10123     { Adobe-Standard-Encoding csAdobeStandardEncoding }
10124     { Ventura-US csVenturaUS }
10125     { Ventura-International csVenturaInternational }
10126     { PC8-Danish-Norwegian csPC8DanishNorwegian }
10127     { PC8-Turkish csPC8Turkish }
10128     { IBM-Symbols csIBMSymbols }
10129     { IBM-Thai csIBMThai }
10130     { HP-Legal csHPLegal }
10131     { HP-Pi-font csHPPiFont }
10132     { HP-Math8 csHPMath8 }
10133     { Adobe-Symbol-Encoding csHPPSMath }
10134     { HP-DeskTop csHPDesktop }
10135     { Ventura-Math csVenturaMath }
10136     { Microsoft-Publishing csMicrosoftPublishing }
10137     { Windows-31J csWindows31J }
10138     { GB2312 csGB2312 }
10139     { Big5 csBig5 }
10140 }
10141
10142 proc tcl_encoding {enc} {
10143     global encoding_aliases tcl_encoding_cache
10144     if {[info exists tcl_encoding_cache($enc)]} {
10145         return $tcl_encoding_cache($enc)
10146     }
10147     set names [encoding names]
10148     set lcnames [string tolower $names]
10149     set enc [string tolower $enc]
10150     set i [lsearch -exact $lcnames $enc]
10151     if {$i < 0} {
10152         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
10153         if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
10154             set i [lsearch -exact $lcnames $encx]
10155         }
10156     }
10157     if {$i < 0} {
10158         foreach l $encoding_aliases {
10159             set ll [string tolower $l]
10160             if {[lsearch -exact $ll $enc] < 0} continue
10161             # look through the aliases for one that tcl knows about
10162             foreach e $ll {
10163                 set i [lsearch -exact $lcnames $e]
10164                 if {$i < 0} {
10165                     if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
10166                         set i [lsearch -exact $lcnames $ex]
10167                     }
10168                 }
10169                 if {$i >= 0} break
10170             }
10171             break
10172         }
10173     }
10174     set tclenc {}
10175     if {$i >= 0} {
10176         set tclenc [lindex $names $i]
10177     }
10178     set tcl_encoding_cache($enc) $tclenc
10179     return $tclenc
10180 }
10181
10182 proc gitattr {path attr default} {
10183     global path_attr_cache
10184     if {[info exists path_attr_cache($attr,$path)]} {
10185         set r $path_attr_cache($attr,$path)
10186     } else {
10187         set r "unspecified"
10188         if {![catch {set line [exec git check-attr $attr -- $path]}]} {
10189             regexp "(.*): encoding: (.*)" $line m f r
10190         }
10191         set path_attr_cache($attr,$path) $r
10192     }
10193     if {$r eq "unspecified"} {
10194         return $default
10195     }
10196     return $r
10197 }
10198
10199 proc cache_gitattr {attr pathlist} {
10200     global path_attr_cache
10201     set newlist {}
10202     foreach path $pathlist {
10203         if {![info exists path_attr_cache($attr,$path)]} {
10204             lappend newlist $path
10205         }
10206     }
10207     set lim 1000
10208     if {[tk windowingsystem] == "win32"} {
10209         # windows has a 32k limit on the arguments to a command...
10210         set lim 30
10211     }
10212     while {$newlist ne {}} {
10213         set head [lrange $newlist 0 [expr {$lim - 1}]]
10214         set newlist [lrange $newlist $lim end]
10215         if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
10216             foreach row [split $rlist "\n"] {
10217                 if {[regexp "(.*): encoding: (.*)" $row m path value]} {
10218                     if {[string index $path 0] eq "\""} {
10219                         set path [encoding convertfrom [lindex $path 0]]
10220                     }
10221                     set path_attr_cache($attr,$path) $value
10222                 }
10223             }
10224         }
10225     }
10226 }
10227
10228 proc get_path_encoding {path} {
10229     global gui_encoding perfile_attrs
10230     set tcl_enc $gui_encoding
10231     if {$path ne {} && $perfile_attrs} {
10232         set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
10233         if {$enc2 ne {}} {
10234             set tcl_enc $enc2
10235         }
10236     }
10237     return $tcl_enc
10238 }
10239
10240 # First check that Tcl/Tk is recent enough
10241 if {[catch {package require Tk 8.4} err]} {
10242     show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
10243                      Gitk requires at least Tcl/Tk 8.4."]
10244     exit 1
10245 }
10246
10247 # defaults...
10248 set wrcomcmd "git diff-tree --stdin -p --pretty"
10249
10250 set gitencoding {}
10251 catch {
10252     set gitencoding [exec git config --get i18n.commitencoding]
10253 }
10254 if {$gitencoding == ""} {
10255     set gitencoding "utf-8"
10256 }
10257 set tclencoding [tcl_encoding $gitencoding]
10258 if {$tclencoding == {}} {
10259     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
10260 }
10261
10262 set gui_encoding [encoding system]
10263 catch {
10264     set enc [exec git config --get gui.encoding]
10265     if {$enc ne {}} {
10266         set tclenc [tcl_encoding $enc]
10267         if {$tclenc ne {}} {
10268             set gui_encoding $tclenc
10269         } else {
10270             puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
10271         }
10272     }
10273 }
10274
10275 set mainfont {Helvetica 9}
10276 set textfont {Courier 9}
10277 set uifont {Helvetica 9 bold}
10278 set tabstop 8
10279 set findmergefiles 0
10280 set maxgraphpct 50
10281 set maxwidth 16
10282 set revlistorder 0
10283 set fastdate 0
10284 set uparrowlen 5
10285 set downarrowlen 5
10286 set mingaplen 100
10287 set cmitmode "patch"
10288 set wrapcomment "none"
10289 set showneartags 1
10290 set maxrefs 20
10291 set maxlinelen 200
10292 set showlocalchanges 1
10293 set limitdiffs 1
10294 set datetimeformat "%Y-%m-%d %H:%M:%S"
10295 set autoselect 1
10296 set perfile_attrs 0
10297
10298 set extdifftool "meld"
10299
10300 set colors {green red blue magenta darkgrey brown orange}
10301 set bgcolor white
10302 set fgcolor black
10303 set diffcolors {red "#00a000" blue}
10304 set diffcontext 3
10305 set ignorespace 0
10306 set selectbgcolor gray85
10307 set markbgcolor "#e0e0ff"
10308
10309 set circlecolors {white blue gray blue blue}
10310
10311 # button for popping up context menus
10312 if {[tk windowingsystem] eq "aqua"} {
10313     set ctxbut <Button-2>
10314 } else {
10315     set ctxbut <Button-3>
10316 }
10317
10318 ## For msgcat loading, first locate the installation location.
10319 if { [info exists ::env(GITK_MSGSDIR)] } {
10320     ## Msgsdir was manually set in the environment.
10321     set gitk_msgsdir $::env(GITK_MSGSDIR)
10322 } else {
10323     ## Let's guess the prefix from argv0.
10324     set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
10325     set gitk_libdir [file join $gitk_prefix share gitk lib]
10326     set gitk_msgsdir [file join $gitk_libdir msgs]
10327     unset gitk_prefix
10328 }
10329
10330 ## Internationalization (i18n) through msgcat and gettext. See
10331 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
10332 package require msgcat
10333 namespace import ::msgcat::mc
10334 ## And eventually load the actual message catalog
10335 ::msgcat::mcload $gitk_msgsdir
10336
10337 catch {source ~/.gitk}
10338
10339 font create optionfont -family sans-serif -size -12
10340
10341 parsefont mainfont $mainfont
10342 eval font create mainfont [fontflags mainfont]
10343 eval font create mainfontbold [fontflags mainfont 1]
10344
10345 parsefont textfont $textfont
10346 eval font create textfont [fontflags textfont]
10347 eval font create textfontbold [fontflags textfont 1]
10348
10349 parsefont uifont $uifont
10350 eval font create uifont [fontflags uifont]
10351
10352 setoptions
10353
10354 # check that we can find a .git directory somewhere...
10355 if {[catch {set gitdir [gitdir]}]} {
10356     show_error {} . [mc "Cannot find a git repository here."]
10357     exit 1
10358 }
10359 if {![file isdirectory $gitdir]} {
10360     show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
10361     exit 1
10362 }
10363
10364 set selecthead {}
10365 set selectheadid {}
10366
10367 set revtreeargs {}
10368 set cmdline_files {}
10369 set i 0
10370 set revtreeargscmd {}
10371 foreach arg $argv {
10372     switch -glob -- $arg {
10373         "" { }
10374         "--" {
10375             set cmdline_files [lrange $argv [expr {$i + 1}] end]
10376             break
10377         }
10378         "--select-commit=*" {
10379             set selecthead [string range $arg 16 end]
10380         }
10381         "--argscmd=*" {
10382             set revtreeargscmd [string range $arg 10 end]
10383         }
10384         default {
10385             lappend revtreeargs $arg
10386         }
10387     }
10388     incr i
10389 }
10390
10391 if {$selecthead eq "HEAD"} {
10392     set selecthead {}
10393 }
10394
10395 if {$i >= [llength $argv] && $revtreeargs ne {}} {
10396     # no -- on command line, but some arguments (other than --argscmd)
10397     if {[catch {
10398         set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
10399         set cmdline_files [split $f "\n"]
10400         set n [llength $cmdline_files]
10401         set revtreeargs [lrange $revtreeargs 0 end-$n]
10402         # Unfortunately git rev-parse doesn't produce an error when
10403         # something is both a revision and a filename.  To be consistent
10404         # with git log and git rev-list, check revtreeargs for filenames.
10405         foreach arg $revtreeargs {
10406             if {[file exists $arg]} {
10407                 show_error {} . [mc "Ambiguous argument '%s': both revision\
10408                                  and filename" $arg]
10409                 exit 1
10410             }
10411         }
10412     } err]} {
10413         # unfortunately we get both stdout and stderr in $err,
10414         # so look for "fatal:".
10415         set i [string first "fatal:" $err]
10416         if {$i > 0} {
10417             set err [string range $err [expr {$i + 6}] end]
10418         }
10419         show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
10420         exit 1
10421     }
10422 }
10423
10424 set nullid "0000000000000000000000000000000000000000"
10425 set nullid2 "0000000000000000000000000000000000000001"
10426 set nullfile "/dev/null"
10427
10428 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
10429
10430 set runq {}
10431 set history {}
10432 set historyindex 0
10433 set fh_serial 0
10434 set nhl_names {}
10435 set highlight_paths {}
10436 set findpattern {}
10437 set searchdirn -forwards
10438 set boldrows {}
10439 set boldnamerows {}
10440 set diffelide {0 0}
10441 set markingmatches 0
10442 set linkentercount 0
10443 set need_redisplay 0
10444 set nrows_drawn 0
10445 set firsttabstop 0
10446
10447 set nextviewnum 1
10448 set curview 0
10449 set selectedview 0
10450 set selectedhlview [mc "None"]
10451 set highlight_related [mc "None"]
10452 set highlight_files {}
10453 set viewfiles(0) {}
10454 set viewperm(0) 0
10455 set viewargs(0) {}
10456 set viewargscmd(0) {}
10457
10458 set selectedline {}
10459 set numcommits 0
10460 set loginstance 0
10461 set cmdlineok 0
10462 set stopped 0
10463 set stuffsaved 0
10464 set patchnum 0
10465 set lserial 0
10466 set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
10467 setcoords
10468 makewindow
10469 # wait for the window to become visible
10470 tkwait visibility .
10471 wm title . "[file tail $argv0]: [file tail [pwd]]"
10472 readrefs
10473
10474 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
10475     # create a view for the files/dirs specified on the command line
10476     set curview 1
10477     set selectedview 1
10478     set nextviewnum 2
10479     set viewname(1) [mc "Command line"]
10480     set viewfiles(1) $cmdline_files
10481     set viewargs(1) $revtreeargs
10482     set viewargscmd(1) $revtreeargscmd
10483     set viewperm(1) 0
10484     set vdatemode(1) 0
10485     addviewmenu 1
10486     .bar.view entryconf [mca "Edit view..."] -state normal
10487     .bar.view entryconf [mca "Delete view"] -state normal
10488 }
10489
10490 if {[info exists permviews]} {
10491     foreach v $permviews {
10492         set n $nextviewnum
10493         incr nextviewnum
10494         set viewname($n) [lindex $v 0]
10495         set viewfiles($n) [lindex $v 1]
10496         set viewargs($n) [lindex $v 2]
10497         set viewargscmd($n) [lindex $v 3]
10498         set viewperm($n) 1
10499         addviewmenu $n
10500     }
10501 }
10502 getcommits {}