gitk

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