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