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