gitk

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