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