gitk

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