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