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