gitk-git/gitk

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