gitk

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