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
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 [encoding convertfrom $diffencoding $line]
7371             # parse the prefix - one ' ', '-' or '+' for each parent
7372             set prefix [string range $line 0 [expr {$diffnparents - 1}]]
7373             set tag [expr {$diffnparents > 1? "m": "d"}]
7374             if {[string trim $prefix " -+"] eq {}} {
7375                 # prefix only has " ", "-" and "+" in it: normal diff line
7376                 set num [string first "-" $prefix]
7377                 if {$num >= 0} {
7378                     # removed line, first parent with line is $num
7379                     if {$num >= $mergemax} {
7380                         set num "max"
7381                     }
7382                     $ctext insert end "$line\n" $tag$num
7383                 } else {
7384                     set tags {}
7385                     if {[string first "+" $prefix] >= 0} {
7386                         # added line
7387                         lappend tags ${tag}result
7388                         if {$diffnparents > 1} {
7389                             set num [string first " " $prefix]
7390                             if {$num >= 0} {
7391                                 if {$num >= $mergemax} {
7392                                     set num "max"
7393                                 }
7394                                 lappend tags m$num
7395                             }
7396                         }
7397                     }
7398                     if {$targetline ne {}} {
7399                         if {$diffline == $targetline} {
7400                             set seehere [$ctext index "end - 1 chars"]
7401                             set targetline {}
7402                         } else {
7403                             incr diffline
7404                         }
7405                     }
7406                     $ctext insert end "$line\n" $tags
7407                 }
7408             } else {
7409                 # "\ No newline at end of file",
7410                 # or something else we don't recognize
7411                 $ctext insert end "$line\n" hunksep
7412             }
7413         }
7414     }
7415     if {[info exists seehere]} {
7416         mark_ctext_line [lindex [split $seehere .] 0]
7417     }
7418     $ctext conf -state disabled
7419     if {[eof $bdf]} {
7420         close $bdf
7421         return 0
7422     }
7423     return [expr {$nr >= 1000? 2: 1}]
7424 }
7425
7426 proc changediffdisp {} {
7427     global ctext diffelide
7428
7429     $ctext tag conf d0 -elide [lindex $diffelide 0]
7430     $ctext tag conf dresult -elide [lindex $diffelide 1]
7431 }
7432
7433 proc highlightfile {loc cline} {
7434     global ctext cflist cflist_top
7435
7436     $ctext yview $loc
7437     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
7438     $cflist tag add highlight $cline.0 "$cline.0 lineend"
7439     $cflist see $cline.0
7440     set cflist_top $cline
7441 }
7442
7443 proc prevfile {} {
7444     global difffilestart ctext cmitmode
7445
7446     if {$cmitmode eq "tree"} return
7447     set prev 0.0
7448     set prevline 1
7449     set here [$ctext index @0,0]
7450     foreach loc $difffilestart {
7451         if {[$ctext compare $loc >= $here]} {
7452             highlightfile $prev $prevline
7453             return
7454         }
7455         set prev $loc
7456         incr prevline
7457     }
7458     highlightfile $prev $prevline
7459 }
7460
7461 proc nextfile {} {
7462     global difffilestart ctext cmitmode
7463
7464     if {$cmitmode eq "tree"} return
7465     set here [$ctext index @0,0]
7466     set line 1
7467     foreach loc $difffilestart {
7468         incr line
7469         if {[$ctext compare $loc > $here]} {
7470             highlightfile $loc $line
7471             return
7472         }
7473     }
7474 }
7475
7476 proc clear_ctext {{first 1.0}} {
7477     global ctext smarktop smarkbot
7478     global ctext_file_names ctext_file_lines
7479     global pendinglinks
7480
7481     set l [lindex [split $first .] 0]
7482     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
7483         set smarktop $l
7484     }
7485     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
7486         set smarkbot $l
7487     }
7488     $ctext delete $first end
7489     if {$first eq "1.0"} {
7490         catch {unset pendinglinks}
7491     }
7492     set ctext_file_names {}
7493     set ctext_file_lines {}
7494 }
7495
7496 proc settabs {{firstab {}}} {
7497     global firsttabstop tabstop ctext have_tk85
7498
7499     if {$firstab ne {} && $have_tk85} {
7500         set firsttabstop $firstab
7501     }
7502     set w [font measure textfont "0"]
7503     if {$firsttabstop != 0} {
7504         $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
7505                                [expr {($firsttabstop + 2 * $tabstop) * $w}]]
7506     } elseif {$have_tk85 || $tabstop != 8} {
7507         $ctext conf -tabs [expr {$tabstop * $w}]
7508     } else {
7509         $ctext conf -tabs {}
7510     }
7511 }
7512
7513 proc incrsearch {name ix op} {
7514     global ctext searchstring searchdirn
7515
7516     $ctext tag remove found 1.0 end
7517     if {[catch {$ctext index anchor}]} {
7518         # no anchor set, use start of selection, or of visible area
7519         set sel [$ctext tag ranges sel]
7520         if {$sel ne {}} {
7521             $ctext mark set anchor [lindex $sel 0]
7522         } elseif {$searchdirn eq "-forwards"} {
7523             $ctext mark set anchor @0,0
7524         } else {
7525             $ctext mark set anchor @0,[winfo height $ctext]
7526         }
7527     }
7528     if {$searchstring ne {}} {
7529         set here [$ctext search $searchdirn -- $searchstring anchor]
7530         if {$here ne {}} {
7531             $ctext see $here
7532         }
7533         searchmarkvisible 1
7534     }
7535 }
7536
7537 proc dosearch {} {
7538     global sstring ctext searchstring searchdirn
7539
7540     focus $sstring
7541     $sstring icursor end
7542     set searchdirn -forwards
7543     if {$searchstring ne {}} {
7544         set sel [$ctext tag ranges sel]
7545         if {$sel ne {}} {
7546             set start "[lindex $sel 0] + 1c"
7547         } elseif {[catch {set start [$ctext index anchor]}]} {
7548             set start "@0,0"
7549         }
7550         set match [$ctext search -count mlen -- $searchstring $start]
7551         $ctext tag remove sel 1.0 end
7552         if {$match eq {}} {
7553             bell
7554             return
7555         }
7556         $ctext see $match
7557         set mend "$match + $mlen c"
7558         $ctext tag add sel $match $mend
7559         $ctext mark unset anchor
7560     }
7561 }
7562
7563 proc dosearchback {} {
7564     global sstring ctext searchstring searchdirn
7565
7566     focus $sstring
7567     $sstring icursor end
7568     set searchdirn -backwards
7569     if {$searchstring ne {}} {
7570         set sel [$ctext tag ranges sel]
7571         if {$sel ne {}} {
7572             set start [lindex $sel 0]
7573         } elseif {[catch {set start [$ctext index anchor]}]} {
7574             set start @0,[winfo height $ctext]
7575         }
7576         set match [$ctext search -backwards -count ml -- $searchstring $start]
7577         $ctext tag remove sel 1.0 end
7578         if {$match eq {}} {
7579             bell
7580             return
7581         }
7582         $ctext see $match
7583         set mend "$match + $ml c"
7584         $ctext tag add sel $match $mend
7585         $ctext mark unset anchor
7586     }
7587 }
7588
7589 proc searchmark {first last} {
7590     global ctext searchstring
7591
7592     set mend $first.0
7593     while {1} {
7594         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
7595         if {$match eq {}} break
7596         set mend "$match + $mlen c"
7597         $ctext tag add found $match $mend
7598     }
7599 }
7600
7601 proc searchmarkvisible {doall} {
7602     global ctext smarktop smarkbot
7603
7604     set topline [lindex [split [$ctext index @0,0] .] 0]
7605     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
7606     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
7607         # no overlap with previous
7608         searchmark $topline $botline
7609         set smarktop $topline
7610         set smarkbot $botline
7611     } else {
7612         if {$topline < $smarktop} {
7613             searchmark $topline [expr {$smarktop-1}]
7614             set smarktop $topline
7615         }
7616         if {$botline > $smarkbot} {
7617             searchmark [expr {$smarkbot+1}] $botline
7618             set smarkbot $botline
7619         }
7620     }
7621 }
7622
7623 proc scrolltext {f0 f1} {
7624     global searchstring
7625
7626     .bleft.bottom.sb set $f0 $f1
7627     if {$searchstring ne {}} {
7628         searchmarkvisible 0
7629     }
7630 }
7631
7632 proc setcoords {} {
7633     global linespc charspc canvx0 canvy0
7634     global xspc1 xspc2 lthickness
7635
7636     set linespc [font metrics mainfont -linespace]
7637     set charspc [font measure mainfont "m"]
7638     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
7639     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
7640     set lthickness [expr {int($linespc / 9) + 1}]
7641     set xspc1(0) $linespc
7642     set xspc2 $linespc
7643 }
7644
7645 proc redisplay {} {
7646     global canv
7647     global selectedline
7648
7649     set ymax [lindex [$canv cget -scrollregion] 3]
7650     if {$ymax eq {} || $ymax == 0} return
7651     set span [$canv yview]
7652     clear_display
7653     setcanvscroll
7654     allcanvs yview moveto [lindex $span 0]
7655     drawvisible
7656     if {$selectedline ne {}} {
7657         selectline $selectedline 0
7658         allcanvs yview moveto [lindex $span 0]
7659     }
7660 }
7661
7662 proc parsefont {f n} {
7663     global fontattr
7664
7665     set fontattr($f,family) [lindex $n 0]
7666     set s [lindex $n 1]
7667     if {$s eq {} || $s == 0} {
7668         set s 10
7669     } elseif {$s < 0} {
7670         set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
7671     }
7672     set fontattr($f,size) $s
7673     set fontattr($f,weight) normal
7674     set fontattr($f,slant) roman
7675     foreach style [lrange $n 2 end] {
7676         switch -- $style {
7677             "normal" -
7678             "bold"   {set fontattr($f,weight) $style}
7679             "roman" -
7680             "italic" {set fontattr($f,slant) $style}
7681         }
7682     }
7683 }
7684
7685 proc fontflags {f {isbold 0}} {
7686     global fontattr
7687
7688     return [list -family $fontattr($f,family) -size $fontattr($f,size) \
7689                 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
7690                 -slant $fontattr($f,slant)]
7691 }
7692
7693 proc fontname {f} {
7694     global fontattr
7695
7696     set n [list $fontattr($f,family) $fontattr($f,size)]
7697     if {$fontattr($f,weight) eq "bold"} {
7698         lappend n "bold"
7699     }
7700     if {$fontattr($f,slant) eq "italic"} {
7701         lappend n "italic"
7702     }
7703     return $n
7704 }
7705
7706 proc incrfont {inc} {
7707     global mainfont textfont ctext canv cflist showrefstop
7708     global stopped entries fontattr
7709
7710     unmarkmatches
7711     set s $fontattr(mainfont,size)
7712     incr s $inc
7713     if {$s < 1} {
7714         set s 1
7715     }
7716     set fontattr(mainfont,size) $s
7717     font config mainfont -size $s
7718     font config mainfontbold -size $s
7719     set mainfont [fontname mainfont]
7720     set s $fontattr(textfont,size)
7721     incr s $inc
7722     if {$s < 1} {
7723         set s 1
7724     }
7725     set fontattr(textfont,size) $s
7726     font config textfont -size $s
7727     font config textfontbold -size $s
7728     set textfont [fontname textfont]
7729     setcoords
7730     settabs
7731     redisplay
7732 }
7733
7734 proc clearsha1 {} {
7735     global sha1entry sha1string
7736     if {[string length $sha1string] == 40} {
7737         $sha1entry delete 0 end
7738     }
7739 }
7740
7741 proc sha1change {n1 n2 op} {
7742     global sha1string currentid sha1but
7743     if {$sha1string == {}
7744         || ([info exists currentid] && $sha1string == $currentid)} {
7745         set state disabled
7746     } else {
7747         set state normal
7748     }
7749     if {[$sha1but cget -state] == $state} return
7750     if {$state == "normal"} {
7751         $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
7752     } else {
7753         $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
7754     }
7755 }
7756
7757 proc gotocommit {} {
7758     global sha1string tagids headids curview varcid
7759
7760     if {$sha1string == {}
7761         || ([info exists currentid] && $sha1string == $currentid)} return
7762     if {[info exists tagids($sha1string)]} {
7763         set id $tagids($sha1string)
7764     } elseif {[info exists headids($sha1string)]} {
7765         set id $headids($sha1string)
7766     } else {
7767         set id [string tolower $sha1string]
7768         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
7769             set matches [longid $id]
7770             if {$matches ne {}} {
7771                 if {[llength $matches] > 1} {
7772                     error_popup [mc "Short SHA1 id %s is ambiguous" $id]
7773                     return
7774                 }
7775                 set id [lindex $matches 0]
7776             }
7777         }
7778     }
7779     if {[commitinview $id $curview]} {
7780         selectline [rowofcommit $id] 1
7781         return
7782     }
7783     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
7784         set msg [mc "SHA1 id %s is not known" $sha1string]
7785     } else {
7786         set msg [mc "Tag/Head %s is not known" $sha1string]
7787     }
7788     error_popup $msg
7789 }
7790
7791 proc lineenter {x y id} {
7792     global hoverx hovery hoverid hovertimer
7793     global commitinfo canv
7794
7795     if {![info exists commitinfo($id)] && ![getcommit $id]} return
7796     set hoverx $x
7797     set hovery $y
7798     set hoverid $id
7799     if {[info exists hovertimer]} {
7800         after cancel $hovertimer
7801     }
7802     set hovertimer [after 500 linehover]
7803     $canv delete hover
7804 }
7805
7806 proc linemotion {x y id} {
7807     global hoverx hovery hoverid hovertimer
7808
7809     if {[info exists hoverid] && $id == $hoverid} {
7810         set hoverx $x
7811         set hovery $y
7812         if {[info exists hovertimer]} {
7813             after cancel $hovertimer
7814         }
7815         set hovertimer [after 500 linehover]
7816     }
7817 }
7818
7819 proc lineleave {id} {
7820     global hoverid hovertimer canv
7821
7822     if {[info exists hoverid] && $id == $hoverid} {
7823         $canv delete hover
7824         if {[info exists hovertimer]} {
7825             after cancel $hovertimer
7826             unset hovertimer
7827         }
7828         unset hoverid
7829     }
7830 }
7831
7832 proc linehover {} {
7833     global hoverx hovery hoverid hovertimer
7834     global canv linespc lthickness
7835     global commitinfo
7836
7837     set text [lindex $commitinfo($hoverid) 0]
7838     set ymax [lindex [$canv cget -scrollregion] 3]
7839     if {$ymax == {}} return
7840     set yfrac [lindex [$canv yview] 0]
7841     set x [expr {$hoverx + 2 * $linespc}]
7842     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
7843     set x0 [expr {$x - 2 * $lthickness}]
7844     set y0 [expr {$y - 2 * $lthickness}]
7845     set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
7846     set y1 [expr {$y + $linespc + 2 * $lthickness}]
7847     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
7848                -fill \#ffff80 -outline black -width 1 -tags hover]
7849     $canv raise $t
7850     set t [$canv create text $x $y -anchor nw -text $text -tags hover \
7851                -font mainfont]
7852     $canv raise $t
7853 }
7854
7855 proc clickisonarrow {id y} {
7856     global lthickness
7857
7858     set ranges [rowranges $id]
7859     set thresh [expr {2 * $lthickness + 6}]
7860     set n [expr {[llength $ranges] - 1}]
7861     for {set i 1} {$i < $n} {incr i} {
7862         set row [lindex $ranges $i]
7863         if {abs([yc $row] - $y) < $thresh} {
7864             return $i
7865         }
7866     }
7867     return {}
7868 }
7869
7870 proc arrowjump {id n y} {
7871     global canv
7872
7873     # 1 <-> 2, 3 <-> 4, etc...
7874     set n [expr {(($n - 1) ^ 1) + 1}]
7875     set row [lindex [rowranges $id] $n]
7876     set yt [yc $row]
7877     set ymax [lindex [$canv cget -scrollregion] 3]
7878     if {$ymax eq {} || $ymax <= 0} return
7879     set view [$canv yview]
7880     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
7881     set yfrac [expr {$yt / $ymax - $yspan / 2}]
7882     if {$yfrac < 0} {
7883         set yfrac 0
7884     }
7885     allcanvs yview moveto $yfrac
7886 }
7887
7888 proc lineclick {x y id isnew} {
7889     global ctext commitinfo children canv thickerline curview
7890
7891     if {![info exists commitinfo($id)] && ![getcommit $id]} return
7892     unmarkmatches
7893     unselectline
7894     normalline
7895     $canv delete hover
7896     # draw this line thicker than normal
7897     set thickerline $id
7898     drawlines $id
7899     if {$isnew} {
7900         set ymax [lindex [$canv cget -scrollregion] 3]
7901         if {$ymax eq {}} return
7902         set yfrac [lindex [$canv yview] 0]
7903         set y [expr {$y + $yfrac * $ymax}]
7904     }
7905     set dirn [clickisonarrow $id $y]
7906     if {$dirn ne {}} {
7907         arrowjump $id $dirn $y
7908         return
7909     }
7910
7911     if {$isnew} {
7912         addtohistory [list lineclick $x $y $id 0]
7913     }
7914     # fill the details pane with info about this line
7915     $ctext conf -state normal
7916     clear_ctext
7917     settabs 0
7918     $ctext insert end "[mc "Parent"]:\t"
7919     $ctext insert end $id link0
7920     setlink $id link0
7921     set info $commitinfo($id)
7922     $ctext insert end "\n\t[lindex $info 0]\n"
7923     $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
7924     set date [formatdate [lindex $info 2]]
7925     $ctext insert end "\t[mc "Date"]:\t$date\n"
7926     set kids $children($curview,$id)
7927     if {$kids ne {}} {
7928         $ctext insert end "\n[mc "Children"]:"
7929         set i 0
7930         foreach child $kids {
7931             incr i
7932             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
7933             set info $commitinfo($child)
7934             $ctext insert end "\n\t"
7935             $ctext insert end $child link$i
7936             setlink $child link$i
7937             $ctext insert end "\n\t[lindex $info 0]"
7938             $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
7939             set date [formatdate [lindex $info 2]]
7940             $ctext insert end "\n\t[mc "Date"]:\t$date\n"
7941         }
7942     }
7943     $ctext conf -state disabled
7944     init_flist {}
7945 }
7946
7947 proc normalline {} {
7948     global thickerline
7949     if {[info exists thickerline]} {
7950         set id $thickerline
7951         unset thickerline
7952         drawlines $id
7953     }
7954 }
7955
7956 proc selbyid {id} {
7957     global curview
7958     if {[commitinview $id $curview]} {
7959         selectline [rowofcommit $id] 1
7960     }
7961 }
7962
7963 proc mstime {} {
7964     global startmstime
7965     if {![info exists startmstime]} {
7966         set startmstime [clock clicks -milliseconds]
7967     }
7968     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
7969 }
7970
7971 proc rowmenu {x y id} {
7972     global rowctxmenu selectedline rowmenuid curview
7973     global nullid nullid2 fakerowmenu mainhead
7974
7975     stopfinding
7976     set rowmenuid $id
7977     if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
7978         set state disabled
7979     } else {
7980         set state normal
7981     }
7982     if {$id ne $nullid && $id ne $nullid2} {
7983         set menu $rowctxmenu
7984         if {$mainhead ne {}} {
7985             $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead] -state normal
7986         } else {
7987             $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
7988         }
7989     } else {
7990         set menu $fakerowmenu
7991     }
7992     $menu entryconfigure [mca "Diff this -> selected"] -state $state
7993     $menu entryconfigure [mca "Diff selected -> this"] -state $state
7994     $menu entryconfigure [mca "Make patch"] -state $state
7995     tk_popup $menu $x $y
7996 }
7997
7998 proc diffvssel {dirn} {
7999     global rowmenuid selectedline
8000
8001     if {$selectedline eq {}} return
8002     if {$dirn} {
8003         set oldid [commitonrow $selectedline]
8004         set newid $rowmenuid
8005     } else {
8006         set oldid $rowmenuid
8007         set newid [commitonrow $selectedline]
8008     }
8009     addtohistory [list doseldiff $oldid $newid]
8010     doseldiff $oldid $newid
8011 }
8012
8013 proc doseldiff {oldid newid} {
8014     global ctext
8015     global commitinfo
8016
8017     $ctext conf -state normal
8018     clear_ctext
8019     init_flist [mc "Top"]
8020     $ctext insert end "[mc "From"] "
8021     $ctext insert end $oldid link0
8022     setlink $oldid link0
8023     $ctext insert end "\n     "
8024     $ctext insert end [lindex $commitinfo($oldid) 0]
8025     $ctext insert end "\n\n[mc "To"]   "
8026     $ctext insert end $newid link1
8027     setlink $newid link1
8028     $ctext insert end "\n     "
8029     $ctext insert end [lindex $commitinfo($newid) 0]
8030     $ctext insert end "\n"
8031     $ctext conf -state disabled
8032     $ctext tag remove found 1.0 end
8033     startdiff [list $oldid $newid]
8034 }
8035
8036 proc mkpatch {} {
8037     global rowmenuid currentid commitinfo patchtop patchnum
8038
8039     if {![info exists currentid]} return
8040     set oldid $currentid
8041     set oldhead [lindex $commitinfo($oldid) 0]
8042     set newid $rowmenuid
8043     set newhead [lindex $commitinfo($newid) 0]
8044     set top .patch
8045     set patchtop $top
8046     catch {destroy $top}
8047     toplevel $top
8048     make_transient $top .
8049     label $top.title -text [mc "Generate patch"]
8050     grid $top.title - -pady 10
8051     label $top.from -text [mc "From:"]
8052     entry $top.fromsha1 -width 40 -relief flat
8053     $top.fromsha1 insert 0 $oldid
8054     $top.fromsha1 conf -state readonly
8055     grid $top.from $top.fromsha1 -sticky w
8056     entry $top.fromhead -width 60 -relief flat
8057     $top.fromhead insert 0 $oldhead
8058     $top.fromhead conf -state readonly
8059     grid x $top.fromhead -sticky w
8060     label $top.to -text [mc "To:"]
8061     entry $top.tosha1 -width 40 -relief flat
8062     $top.tosha1 insert 0 $newid
8063     $top.tosha1 conf -state readonly
8064     grid $top.to $top.tosha1 -sticky w
8065     entry $top.tohead -width 60 -relief flat
8066     $top.tohead insert 0 $newhead
8067     $top.tohead conf -state readonly
8068     grid x $top.tohead -sticky w
8069     button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
8070     grid $top.rev x -pady 10
8071     label $top.flab -text [mc "Output file:"]
8072     entry $top.fname -width 60
8073     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
8074     incr patchnum
8075     grid $top.flab $top.fname -sticky w
8076     frame $top.buts
8077     button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
8078     button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
8079     bind $top <Key-Return> mkpatchgo
8080     bind $top <Key-Escape> mkpatchcan
8081     grid $top.buts.gen $top.buts.can
8082     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8083     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8084     grid $top.buts - -pady 10 -sticky ew
8085     focus $top.fname
8086 }
8087
8088 proc mkpatchrev {} {
8089     global patchtop
8090
8091     set oldid [$patchtop.fromsha1 get]
8092     set oldhead [$patchtop.fromhead get]
8093     set newid [$patchtop.tosha1 get]
8094     set newhead [$patchtop.tohead get]
8095     foreach e [list fromsha1 fromhead tosha1 tohead] \
8096             v [list $newid $newhead $oldid $oldhead] {
8097         $patchtop.$e conf -state normal
8098         $patchtop.$e delete 0 end
8099         $patchtop.$e insert 0 $v
8100         $patchtop.$e conf -state readonly
8101     }
8102 }
8103
8104 proc mkpatchgo {} {
8105     global patchtop nullid nullid2
8106
8107     set oldid [$patchtop.fromsha1 get]
8108     set newid [$patchtop.tosha1 get]
8109     set fname [$patchtop.fname get]
8110     set cmd [diffcmd [list $oldid $newid] -p]
8111     # trim off the initial "|"
8112     set cmd [lrange $cmd 1 end]
8113     lappend cmd >$fname &
8114     if {[catch {eval exec $cmd} err]} {
8115         error_popup "[mc "Error creating patch:"] $err" $patchtop
8116     }
8117     catch {destroy $patchtop}
8118     unset patchtop
8119 }
8120
8121 proc mkpatchcan {} {
8122     global patchtop
8123
8124     catch {destroy $patchtop}
8125     unset patchtop
8126 }
8127
8128 proc mktag {} {
8129     global rowmenuid mktagtop commitinfo
8130
8131     set top .maketag
8132     set mktagtop $top
8133     catch {destroy $top}
8134     toplevel $top
8135     make_transient $top .
8136     label $top.title -text [mc "Create tag"]
8137     grid $top.title - -pady 10
8138     label $top.id -text [mc "ID:"]
8139     entry $top.sha1 -width 40 -relief flat
8140     $top.sha1 insert 0 $rowmenuid
8141     $top.sha1 conf -state readonly
8142     grid $top.id $top.sha1 -sticky w
8143     entry $top.head -width 60 -relief flat
8144     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8145     $top.head conf -state readonly
8146     grid x $top.head -sticky w
8147     label $top.tlab -text [mc "Tag name:"]
8148     entry $top.tag -width 60
8149     grid $top.tlab $top.tag -sticky w
8150     frame $top.buts
8151     button $top.buts.gen -text [mc "Create"] -command mktaggo
8152     button $top.buts.can -text [mc "Cancel"] -command mktagcan
8153     bind $top <Key-Return> mktaggo
8154     bind $top <Key-Escape> mktagcan
8155     grid $top.buts.gen $top.buts.can
8156     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8157     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8158     grid $top.buts - -pady 10 -sticky ew
8159     focus $top.tag
8160 }
8161
8162 proc domktag {} {
8163     global mktagtop env tagids idtags
8164
8165     set id [$mktagtop.sha1 get]
8166     set tag [$mktagtop.tag get]
8167     if {$tag == {}} {
8168         error_popup [mc "No tag name specified"] $mktagtop
8169         return 0
8170     }
8171     if {[info exists tagids($tag)]} {
8172         error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
8173         return 0
8174     }
8175     if {[catch {
8176         exec git tag $tag $id
8177     } err]} {
8178         error_popup "[mc "Error creating tag:"] $err" $mktagtop
8179         return 0
8180     }
8181
8182     set tagids($tag) $id
8183     lappend idtags($id) $tag
8184     redrawtags $id
8185     addedtag $id
8186     dispneartags 0
8187     run refill_reflist
8188     return 1
8189 }
8190
8191 proc redrawtags {id} {
8192     global canv linehtag idpos currentid curview cmitlisted
8193     global canvxmax iddrawn circleitem mainheadid circlecolors
8194
8195     if {![commitinview $id $curview]} return
8196     if {![info exists iddrawn($id)]} return
8197     set row [rowofcommit $id]
8198     if {$id eq $mainheadid} {
8199         set ofill yellow
8200     } else {
8201         set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
8202     }
8203     $canv itemconf $circleitem($row) -fill $ofill
8204     $canv delete tag.$id
8205     set xt [eval drawtags $id $idpos($id)]
8206     $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
8207     set text [$canv itemcget $linehtag($id) -text]
8208     set font [$canv itemcget $linehtag($id) -font]
8209     set xr [expr {$xt + [font measure $font $text]}]
8210     if {$xr > $canvxmax} {
8211         set canvxmax $xr
8212         setcanvscroll
8213     }
8214     if {[info exists currentid] && $currentid == $id} {
8215         make_secsel $id
8216     }
8217 }
8218
8219 proc mktagcan {} {
8220     global mktagtop
8221
8222     catch {destroy $mktagtop}
8223     unset mktagtop
8224 }
8225
8226 proc mktaggo {} {
8227     if {![domktag]} return
8228     mktagcan
8229 }
8230
8231 proc writecommit {} {
8232     global rowmenuid wrcomtop commitinfo wrcomcmd
8233
8234     set top .writecommit
8235     set wrcomtop $top
8236     catch {destroy $top}
8237     toplevel $top
8238     make_transient $top .
8239     label $top.title -text [mc "Write commit to file"]
8240     grid $top.title - -pady 10
8241     label $top.id -text [mc "ID:"]
8242     entry $top.sha1 -width 40 -relief flat
8243     $top.sha1 insert 0 $rowmenuid
8244     $top.sha1 conf -state readonly
8245     grid $top.id $top.sha1 -sticky w
8246     entry $top.head -width 60 -relief flat
8247     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8248     $top.head conf -state readonly
8249     grid x $top.head -sticky w
8250     label $top.clab -text [mc "Command:"]
8251     entry $top.cmd -width 60 -textvariable wrcomcmd
8252     grid $top.clab $top.cmd -sticky w -pady 10
8253     label $top.flab -text [mc "Output file:"]
8254     entry $top.fname -width 60
8255     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
8256     grid $top.flab $top.fname -sticky w
8257     frame $top.buts
8258     button $top.buts.gen -text [mc "Write"] -command wrcomgo
8259     button $top.buts.can -text [mc "Cancel"] -command wrcomcan
8260     bind $top <Key-Return> wrcomgo
8261     bind $top <Key-Escape> wrcomcan
8262     grid $top.buts.gen $top.buts.can
8263     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8264     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8265     grid $top.buts - -pady 10 -sticky ew
8266     focus $top.fname
8267 }
8268
8269 proc wrcomgo {} {
8270     global wrcomtop
8271
8272     set id [$wrcomtop.sha1 get]
8273     set cmd "echo $id | [$wrcomtop.cmd get]"
8274     set fname [$wrcomtop.fname get]
8275     if {[catch {exec sh -c $cmd >$fname &} err]} {
8276         error_popup "[mc "Error writing commit:"] $err" $wrcomtop
8277     }
8278     catch {destroy $wrcomtop}
8279     unset wrcomtop
8280 }
8281
8282 proc wrcomcan {} {
8283     global wrcomtop
8284
8285     catch {destroy $wrcomtop}
8286     unset wrcomtop
8287 }
8288
8289 proc mkbranch {} {
8290     global rowmenuid mkbrtop
8291
8292     set top .makebranch
8293     catch {destroy $top}
8294     toplevel $top
8295     make_transient $top .
8296     label $top.title -text [mc "Create new branch"]
8297     grid $top.title - -pady 10
8298     label $top.id -text [mc "ID:"]
8299     entry $top.sha1 -width 40 -relief flat
8300     $top.sha1 insert 0 $rowmenuid
8301     $top.sha1 conf -state readonly
8302     grid $top.id $top.sha1 -sticky w
8303     label $top.nlab -text [mc "Name:"]
8304     entry $top.name -width 40
8305     grid $top.nlab $top.name -sticky w
8306     frame $top.buts
8307     button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
8308     button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
8309     bind $top <Key-Return> [list mkbrgo $top]
8310     bind $top <Key-Escape> "catch {destroy $top}"
8311     grid $top.buts.go $top.buts.can
8312     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8313     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8314     grid $top.buts - -pady 10 -sticky ew
8315     focus $top.name
8316 }
8317
8318 proc mkbrgo {top} {
8319     global headids idheads
8320
8321     set name [$top.name get]
8322     set id [$top.sha1 get]
8323     set cmdargs {}
8324     set old_id {}
8325     if {$name eq {}} {
8326         error_popup [mc "Please specify a name for the new branch"] $top
8327         return
8328     }
8329     if {[info exists headids($name)]} {
8330         if {![confirm_popup [mc \
8331                 "Branch '%s' already exists. Overwrite?" $name] $top]} {
8332             return
8333         }
8334         set old_id $headids($name)
8335         lappend cmdargs -f
8336     }
8337     catch {destroy $top}
8338     lappend cmdargs $name $id
8339     nowbusy newbranch
8340     update
8341     if {[catch {
8342         eval exec git branch $cmdargs
8343     } err]} {
8344         notbusy newbranch
8345         error_popup $err
8346     } else {
8347         notbusy newbranch
8348         if {$old_id ne {}} {
8349             movehead $id $name
8350             movedhead $id $name
8351             redrawtags $old_id
8352             redrawtags $id
8353         } else {
8354             set headids($name) $id
8355             lappend idheads($id) $name
8356             addedhead $id $name
8357             redrawtags $id
8358         }
8359         dispneartags 0
8360         run refill_reflist
8361     }
8362 }
8363
8364 proc exec_citool {tool_args {baseid {}}} {
8365     global commitinfo env
8366
8367     set save_env [array get env GIT_AUTHOR_*]
8368
8369     if {$baseid ne {}} {
8370         if {![info exists commitinfo($baseid)]} {
8371             getcommit $baseid
8372         }
8373         set author [lindex $commitinfo($baseid) 1]
8374         set date [lindex $commitinfo($baseid) 2]
8375         if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
8376                     $author author name email]
8377             && $date ne {}} {
8378             set env(GIT_AUTHOR_NAME) $name
8379             set env(GIT_AUTHOR_EMAIL) $email
8380             set env(GIT_AUTHOR_DATE) $date
8381         }
8382     }
8383
8384     eval exec git citool $tool_args &
8385
8386     array unset env GIT_AUTHOR_*
8387     array set env $save_env
8388 }
8389
8390 proc cherrypick {} {
8391     global rowmenuid curview
8392     global mainhead mainheadid
8393
8394     set oldhead [exec git rev-parse HEAD]
8395     set dheads [descheads $rowmenuid]
8396     if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
8397         set ok [confirm_popup [mc "Commit %s is already\
8398                 included in branch %s -- really re-apply it?" \
8399                                    [string range $rowmenuid 0 7] $mainhead]]
8400         if {!$ok} return
8401     }
8402     nowbusy cherrypick [mc "Cherry-picking"]
8403     update
8404     # Unfortunately git-cherry-pick writes stuff to stderr even when
8405     # no error occurs, and exec takes that as an indication of error...
8406     if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
8407         notbusy cherrypick
8408         if {[regexp -line \
8409                  {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
8410                  $err msg fname]} {
8411             error_popup [mc "Cherry-pick failed because of local changes\
8412                         to file '%s'.\nPlease commit, reset or stash\
8413                         your changes and try again." $fname]
8414         } elseif {[regexp -line \
8415                        {^(CONFLICT \(.*\):|Automatic cherry-pick failed)} \
8416                        $err]} {
8417             if {[confirm_popup [mc "Cherry-pick failed because of merge\
8418                         conflict.\nDo you wish to run git citool to\
8419                         resolve it?"]]} {
8420                 # Force citool to read MERGE_MSG
8421                 file delete [file join [gitdir] "GITGUI_MSG"]
8422                 exec_citool {} $rowmenuid
8423             }
8424         } else {
8425             error_popup $err
8426         }
8427         run updatecommits
8428         return
8429     }
8430     set newhead [exec git rev-parse HEAD]
8431     if {$newhead eq $oldhead} {
8432         notbusy cherrypick
8433         error_popup [mc "No changes committed"]
8434         return
8435     }
8436     addnewchild $newhead $oldhead
8437     if {[commitinview $oldhead $curview]} {
8438         # XXX this isn't right if we have a path limit...
8439         insertrow $newhead $oldhead $curview
8440         if {$mainhead ne {}} {
8441             movehead $newhead $mainhead
8442             movedhead $newhead $mainhead
8443         }
8444         set mainheadid $newhead
8445         redrawtags $oldhead
8446         redrawtags $newhead
8447         selbyid $newhead
8448     }
8449     notbusy cherrypick
8450 }
8451
8452 proc resethead {} {
8453     global mainhead rowmenuid confirm_ok resettype
8454
8455     set confirm_ok 0
8456     set w ".confirmreset"
8457     toplevel $w
8458     make_transient $w .
8459     wm title $w [mc "Confirm reset"]
8460     message $w.m -text \
8461         [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
8462         -justify center -aspect 1000
8463     pack $w.m -side top -fill x -padx 20 -pady 20
8464     frame $w.f -relief sunken -border 2
8465     message $w.f.rt -text [mc "Reset type:"] -aspect 1000
8466     grid $w.f.rt -sticky w
8467     set resettype mixed
8468     radiobutton $w.f.soft -value soft -variable resettype -justify left \
8469         -text [mc "Soft: Leave working tree and index untouched"]
8470     grid $w.f.soft -sticky w
8471     radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
8472         -text [mc "Mixed: Leave working tree untouched, reset index"]
8473     grid $w.f.mixed -sticky w
8474     radiobutton $w.f.hard -value hard -variable resettype -justify left \
8475         -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
8476     grid $w.f.hard -sticky w
8477     pack $w.f -side top -fill x
8478     button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
8479     pack $w.ok -side left -fill x -padx 20 -pady 20
8480     button $w.cancel -text [mc Cancel] -command "destroy $w"
8481     bind $w <Key-Escape> [list destroy $w]
8482     pack $w.cancel -side right -fill x -padx 20 -pady 20
8483     bind $w <Visibility> "grab $w; focus $w"
8484     tkwait window $w
8485     if {!$confirm_ok} return
8486     if {[catch {set fd [open \
8487             [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
8488         error_popup $err
8489     } else {
8490         dohidelocalchanges
8491         filerun $fd [list readresetstat $fd]
8492         nowbusy reset [mc "Resetting"]
8493         selbyid $rowmenuid
8494     }
8495 }
8496
8497 proc readresetstat {fd} {
8498     global mainhead mainheadid showlocalchanges rprogcoord
8499
8500     if {[gets $fd line] >= 0} {
8501         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
8502             set rprogcoord [expr {1.0 * $m / $n}]
8503             adjustprogress
8504         }
8505         return 1
8506     }
8507     set rprogcoord 0
8508     adjustprogress
8509     notbusy reset
8510     if {[catch {close $fd} err]} {
8511         error_popup $err
8512     }
8513     set oldhead $mainheadid
8514     set newhead [exec git rev-parse HEAD]
8515     if {$newhead ne $oldhead} {
8516         movehead $newhead $mainhead
8517         movedhead $newhead $mainhead
8518         set mainheadid $newhead
8519         redrawtags $oldhead
8520         redrawtags $newhead
8521     }
8522     if {$showlocalchanges} {
8523         doshowlocalchanges
8524     }
8525     return 0
8526 }
8527
8528 # context menu for a head
8529 proc headmenu {x y id head} {
8530     global headmenuid headmenuhead headctxmenu mainhead
8531
8532     stopfinding
8533     set headmenuid $id
8534     set headmenuhead $head
8535     set state normal
8536     if {$head eq $mainhead} {
8537         set state disabled
8538     }
8539     $headctxmenu entryconfigure 0 -state $state
8540     $headctxmenu entryconfigure 1 -state $state
8541     tk_popup $headctxmenu $x $y
8542 }
8543
8544 proc cobranch {} {
8545     global headmenuid headmenuhead headids
8546     global showlocalchanges
8547
8548     # check the tree is clean first??
8549     nowbusy checkout [mc "Checking out"]
8550     update
8551     dohidelocalchanges
8552     if {[catch {
8553         set fd [open [list | git checkout $headmenuhead 2>@1] r]
8554     } err]} {
8555         notbusy checkout
8556         error_popup $err
8557         if {$showlocalchanges} {
8558             dodiffindex
8559         }
8560     } else {
8561         filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
8562     }
8563 }
8564
8565 proc readcheckoutstat {fd newhead newheadid} {
8566     global mainhead mainheadid headids showlocalchanges progresscoords
8567     global viewmainheadid curview
8568
8569     if {[gets $fd line] >= 0} {
8570         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
8571             set progresscoords [list 0 [expr {1.0 * $m / $n}]]
8572             adjustprogress
8573         }
8574         return 1
8575     }
8576     set progresscoords {0 0}
8577     adjustprogress
8578     notbusy checkout
8579     if {[catch {close $fd} err]} {
8580         error_popup $err
8581     }
8582     set oldmainid $mainheadid
8583     set mainhead $newhead
8584     set mainheadid $newheadid
8585     set viewmainheadid($curview) $newheadid
8586     redrawtags $oldmainid
8587     redrawtags $newheadid
8588     selbyid $newheadid
8589     if {$showlocalchanges} {
8590         dodiffindex
8591     }
8592 }
8593
8594 proc rmbranch {} {
8595     global headmenuid headmenuhead mainhead
8596     global idheads
8597
8598     set head $headmenuhead
8599     set id $headmenuid
8600     # this check shouldn't be needed any more...
8601     if {$head eq $mainhead} {
8602         error_popup [mc "Cannot delete the currently checked-out branch"]
8603         return
8604     }
8605     set dheads [descheads $id]
8606     if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
8607         # the stuff on this branch isn't on any other branch
8608         if {![confirm_popup [mc "The commits on branch %s aren't on any other\
8609                         branch.\nReally delete branch %s?" $head $head]]} return
8610     }
8611     nowbusy rmbranch
8612     update
8613     if {[catch {exec git branch -D $head} err]} {
8614         notbusy rmbranch
8615         error_popup $err
8616         return
8617     }
8618     removehead $id $head
8619     removedhead $id $head
8620     redrawtags $id
8621     notbusy rmbranch
8622     dispneartags 0
8623     run refill_reflist
8624 }
8625
8626 # Display a list of tags and heads
8627 proc showrefs {} {
8628     global showrefstop bgcolor fgcolor selectbgcolor
8629     global bglist fglist reflistfilter reflist maincursor
8630
8631     set top .showrefs
8632     set showrefstop $top
8633     if {[winfo exists $top]} {
8634         raise $top
8635         refill_reflist
8636         return
8637     }
8638     toplevel $top
8639     wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
8640     make_transient $top .
8641     text $top.list -background $bgcolor -foreground $fgcolor \
8642         -selectbackground $selectbgcolor -font mainfont \
8643         -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
8644         -width 30 -height 20 -cursor $maincursor \
8645         -spacing1 1 -spacing3 1 -state disabled
8646     $top.list tag configure highlight -background $selectbgcolor
8647     lappend bglist $top.list
8648     lappend fglist $top.list
8649     scrollbar $top.ysb -command "$top.list yview" -orient vertical
8650     scrollbar $top.xsb -command "$top.list xview" -orient horizontal
8651     grid $top.list $top.ysb -sticky nsew
8652     grid $top.xsb x -sticky ew
8653     frame $top.f
8654     label $top.f.l -text "[mc "Filter"]: "
8655     entry $top.f.e -width 20 -textvariable reflistfilter
8656     set reflistfilter "*"
8657     trace add variable reflistfilter write reflistfilter_change
8658     pack $top.f.e -side right -fill x -expand 1
8659     pack $top.f.l -side left
8660     grid $top.f - -sticky ew -pady 2
8661     button $top.close -command [list destroy $top] -text [mc "Close"]
8662     bind $top <Key-Escape> [list destroy $top]
8663     grid $top.close -
8664     grid columnconfigure $top 0 -weight 1
8665     grid rowconfigure $top 0 -weight 1
8666     bind $top.list <1> {break}
8667     bind $top.list <B1-Motion> {break}
8668     bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
8669     set reflist {}
8670     refill_reflist
8671 }
8672
8673 proc sel_reflist {w x y} {
8674     global showrefstop reflist headids tagids otherrefids
8675
8676     if {![winfo exists $showrefstop]} return
8677     set l [lindex [split [$w index "@$x,$y"] "."] 0]
8678     set ref [lindex $reflist [expr {$l-1}]]
8679     set n [lindex $ref 0]
8680     switch -- [lindex $ref 1] {
8681         "H" {selbyid $headids($n)}
8682         "T" {selbyid $tagids($n)}
8683         "o" {selbyid $otherrefids($n)}
8684     }
8685     $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
8686 }
8687
8688 proc unsel_reflist {} {
8689     global showrefstop
8690
8691     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
8692     $showrefstop.list tag remove highlight 0.0 end
8693 }
8694
8695 proc reflistfilter_change {n1 n2 op} {
8696     global reflistfilter
8697
8698     after cancel refill_reflist
8699     after 200 refill_reflist
8700 }
8701
8702 proc refill_reflist {} {
8703     global reflist reflistfilter showrefstop headids tagids otherrefids
8704     global curview
8705
8706     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
8707     set refs {}
8708     foreach n [array names headids] {
8709         if {[string match $reflistfilter $n]} {
8710             if {[commitinview $headids($n) $curview]} {
8711                 lappend refs [list $n H]
8712             } else {
8713                 interestedin $headids($n) {run refill_reflist}
8714             }
8715         }
8716     }
8717     foreach n [array names tagids] {
8718         if {[string match $reflistfilter $n]} {
8719             if {[commitinview $tagids($n) $curview]} {
8720                 lappend refs [list $n T]
8721             } else {
8722                 interestedin $tagids($n) {run refill_reflist}
8723             }
8724         }
8725     }
8726     foreach n [array names otherrefids] {
8727         if {[string match $reflistfilter $n]} {
8728             if {[commitinview $otherrefids($n) $curview]} {
8729                 lappend refs [list $n o]
8730             } else {
8731                 interestedin $otherrefids($n) {run refill_reflist}
8732             }
8733         }
8734     }
8735     set refs [lsort -index 0 $refs]
8736     if {$refs eq $reflist} return
8737
8738     # Update the contents of $showrefstop.list according to the
8739     # differences between $reflist (old) and $refs (new)
8740     $showrefstop.list conf -state normal
8741     $showrefstop.list insert end "\n"
8742     set i 0
8743     set j 0
8744     while {$i < [llength $reflist] || $j < [llength $refs]} {
8745         if {$i < [llength $reflist]} {
8746             if {$j < [llength $refs]} {
8747                 set cmp [string compare [lindex $reflist $i 0] \
8748                              [lindex $refs $j 0]]
8749                 if {$cmp == 0} {
8750                     set cmp [string compare [lindex $reflist $i 1] \
8751                                  [lindex $refs $j 1]]
8752                 }
8753             } else {
8754                 set cmp -1
8755             }
8756         } else {
8757             set cmp 1
8758         }
8759         switch -- $cmp {
8760             -1 {
8761                 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
8762                 incr i
8763             }
8764             0 {
8765                 incr i
8766                 incr j
8767             }
8768             1 {
8769                 set l [expr {$j + 1}]
8770                 $showrefstop.list image create $l.0 -align baseline \
8771                     -image reficon-[lindex $refs $j 1] -padx 2
8772                 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
8773                 incr j
8774             }
8775         }
8776     }
8777     set reflist $refs
8778     # delete last newline
8779     $showrefstop.list delete end-2c end-1c
8780     $showrefstop.list conf -state disabled
8781 }
8782
8783 # Stuff for finding nearby tags
8784 proc getallcommits {} {
8785     global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
8786     global idheads idtags idotherrefs allparents tagobjid
8787
8788     if {![info exists allcommits]} {
8789         set nextarc 0
8790         set allcommits 0
8791         set seeds {}
8792         set allcwait 0
8793         set cachedarcs 0
8794         set allccache [file join [gitdir] "gitk.cache"]
8795         if {![catch {
8796             set f [open $allccache r]
8797             set allcwait 1
8798             getcache $f
8799         }]} return
8800     }
8801
8802     if {$allcwait} {
8803         return
8804     }
8805     set cmd [list | git rev-list --parents]
8806     set allcupdate [expr {$seeds ne {}}]
8807     if {!$allcupdate} {
8808         set ids "--all"
8809     } else {
8810         set refs [concat [array names idheads] [array names idtags] \
8811                       [array names idotherrefs]]
8812         set ids {}
8813         set tagobjs {}
8814         foreach name [array names tagobjid] {
8815             lappend tagobjs $tagobjid($name)
8816         }
8817         foreach id [lsort -unique $refs] {
8818             if {![info exists allparents($id)] &&
8819                 [lsearch -exact $tagobjs $id] < 0} {
8820                 lappend ids $id
8821             }
8822         }
8823         if {$ids ne {}} {
8824             foreach id $seeds {
8825                 lappend ids "^$id"
8826             }
8827         }
8828     }
8829     if {$ids ne {}} {
8830         set fd [open [concat $cmd $ids] r]
8831         fconfigure $fd -blocking 0
8832         incr allcommits
8833         nowbusy allcommits
8834         filerun $fd [list getallclines $fd]
8835     } else {
8836         dispneartags 0
8837     }
8838 }
8839
8840 # Since most commits have 1 parent and 1 child, we group strings of
8841 # such commits into "arcs" joining branch/merge points (BMPs), which
8842 # are commits that either don't have 1 parent or don't have 1 child.
8843 #
8844 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
8845 # arcout(id) - outgoing arcs for BMP
8846 # arcids(a) - list of IDs on arc including end but not start
8847 # arcstart(a) - BMP ID at start of arc
8848 # arcend(a) - BMP ID at end of arc
8849 # growing(a) - arc a is still growing
8850 # arctags(a) - IDs out of arcids (excluding end) that have tags
8851 # archeads(a) - IDs out of arcids (excluding end) that have heads
8852 # The start of an arc is at the descendent end, so "incoming" means
8853 # coming from descendents, and "outgoing" means going towards ancestors.
8854
8855 proc getallclines {fd} {
8856     global allparents allchildren idtags idheads nextarc
8857     global arcnos arcids arctags arcout arcend arcstart archeads growing
8858     global seeds allcommits cachedarcs allcupdate
8859
8860     set nid 0
8861     while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
8862         set id [lindex $line 0]
8863         if {[info exists allparents($id)]} {
8864             # seen it already
8865             continue
8866         }
8867         set cachedarcs 0
8868         set olds [lrange $line 1 end]
8869         set allparents($id) $olds
8870         if {![info exists allchildren($id)]} {
8871             set allchildren($id) {}
8872             set arcnos($id) {}
8873             lappend seeds $id
8874         } else {
8875             set a $arcnos($id)
8876             if {[llength $olds] == 1 && [llength $a] == 1} {
8877                 lappend arcids($a) $id
8878                 if {[info exists idtags($id)]} {
8879                     lappend arctags($a) $id
8880                 }
8881                 if {[info exists idheads($id)]} {
8882                     lappend archeads($a) $id
8883                 }
8884                 if {[info exists allparents($olds)]} {
8885                     # seen parent already
8886                     if {![info exists arcout($olds)]} {
8887                         splitarc $olds
8888                     }
8889                     lappend arcids($a) $olds
8890                     set arcend($a) $olds
8891                     unset growing($a)
8892                 }
8893                 lappend allchildren($olds) $id
8894                 lappend arcnos($olds) $a
8895                 continue
8896             }
8897         }
8898         foreach a $arcnos($id) {
8899             lappend arcids($a) $id
8900             set arcend($a) $id
8901             unset growing($a)
8902         }
8903
8904         set ao {}
8905         foreach p $olds {
8906             lappend allchildren($p) $id
8907             set a [incr nextarc]
8908             set arcstart($a) $id
8909             set archeads($a) {}
8910             set arctags($a) {}
8911             set archeads($a) {}
8912             set arcids($a) {}
8913             lappend ao $a
8914             set growing($a) 1
8915             if {[info exists allparents($p)]} {
8916                 # seen it already, may need to make a new branch
8917                 if {![info exists arcout($p)]} {
8918                     splitarc $p
8919                 }
8920                 lappend arcids($a) $p
8921                 set arcend($a) $p
8922                 unset growing($a)
8923             }
8924             lappend arcnos($p) $a
8925         }
8926         set arcout($id) $ao
8927     }
8928     if {$nid > 0} {
8929         global cached_dheads cached_dtags cached_atags
8930         catch {unset cached_dheads}
8931         catch {unset cached_dtags}
8932         catch {unset cached_atags}
8933     }
8934     if {![eof $fd]} {
8935         return [expr {$nid >= 1000? 2: 1}]
8936     }
8937     set cacheok 1
8938     if {[catch {
8939         fconfigure $fd -blocking 1
8940         close $fd
8941     } err]} {
8942         # got an error reading the list of commits
8943         # if we were updating, try rereading the whole thing again
8944         if {$allcupdate} {
8945             incr allcommits -1
8946             dropcache $err
8947             return
8948         }
8949         error_popup "[mc "Error reading commit topology information;\
8950                 branch and preceding/following tag information\
8951                 will be incomplete."]\n($err)"
8952         set cacheok 0
8953     }
8954     if {[incr allcommits -1] == 0} {
8955         notbusy allcommits
8956         if {$cacheok} {
8957             run savecache
8958         }
8959     }
8960     dispneartags 0
8961     return 0
8962 }
8963
8964 proc recalcarc {a} {
8965     global arctags archeads arcids idtags idheads
8966
8967     set at {}
8968     set ah {}
8969     foreach id [lrange $arcids($a) 0 end-1] {
8970         if {[info exists idtags($id)]} {
8971             lappend at $id
8972         }
8973         if {[info exists idheads($id)]} {
8974             lappend ah $id
8975         }
8976     }
8977     set arctags($a) $at
8978     set archeads($a) $ah
8979 }
8980
8981 proc splitarc {p} {
8982     global arcnos arcids nextarc arctags archeads idtags idheads
8983     global arcstart arcend arcout allparents growing
8984
8985     set a $arcnos($p)
8986     if {[llength $a] != 1} {
8987         puts "oops splitarc called but [llength $a] arcs already"
8988         return
8989     }
8990     set a [lindex $a 0]
8991     set i [lsearch -exact $arcids($a) $p]
8992     if {$i < 0} {
8993         puts "oops splitarc $p not in arc $a"
8994         return
8995     }
8996     set na [incr nextarc]
8997     if {[info exists arcend($a)]} {
8998         set arcend($na) $arcend($a)
8999     } else {
9000         set l [lindex $allparents([lindex $arcids($a) end]) 0]
9001         set j [lsearch -exact $arcnos($l) $a]
9002         set arcnos($l) [lreplace $arcnos($l) $j $j $na]
9003     }
9004     set tail [lrange $arcids($a) [expr {$i+1}] end]
9005     set arcids($a) [lrange $arcids($a) 0 $i]
9006     set arcend($a) $p
9007     set arcstart($na) $p
9008     set arcout($p) $na
9009     set arcids($na) $tail
9010     if {[info exists growing($a)]} {
9011         set growing($na) 1
9012         unset growing($a)
9013     }
9014
9015     foreach id $tail {
9016         if {[llength $arcnos($id)] == 1} {
9017             set arcnos($id) $na
9018         } else {
9019             set j [lsearch -exact $arcnos($id) $a]
9020             set arcnos($id) [lreplace $arcnos($id) $j $j $na]
9021         }
9022     }
9023
9024     # reconstruct tags and heads lists
9025     if {$arctags($a) ne {} || $archeads($a) ne {}} {
9026         recalcarc $a
9027         recalcarc $na
9028     } else {
9029         set arctags($na) {}
9030         set archeads($na) {}
9031     }
9032 }
9033
9034 # Update things for a new commit added that is a child of one
9035 # existing commit.  Used when cherry-picking.
9036 proc addnewchild {id p} {
9037     global allparents allchildren idtags nextarc
9038     global arcnos arcids arctags arcout arcend arcstart archeads growing
9039     global seeds allcommits
9040
9041     if {![info exists allcommits] || ![info exists arcnos($p)]} return
9042     set allparents($id) [list $p]
9043     set allchildren($id) {}
9044     set arcnos($id) {}
9045     lappend seeds $id
9046     lappend allchildren($p) $id
9047     set a [incr nextarc]
9048     set arcstart($a) $id
9049     set archeads($a) {}
9050     set arctags($a) {}
9051     set arcids($a) [list $p]
9052     set arcend($a) $p
9053     if {![info exists arcout($p)]} {
9054         splitarc $p
9055     }
9056     lappend arcnos($p) $a
9057     set arcout($id) [list $a]
9058 }
9059
9060 # This implements a cache for the topology information.
9061 # The cache saves, for each arc, the start and end of the arc,
9062 # the ids on the arc, and the outgoing arcs from the end.
9063 proc readcache {f} {
9064     global arcnos arcids arcout arcstart arcend arctags archeads nextarc
9065     global idtags idheads allparents cachedarcs possible_seeds seeds growing
9066     global allcwait
9067
9068     set a $nextarc
9069     set lim $cachedarcs
9070     if {$lim - $a > 500} {
9071         set lim [expr {$a + 500}]
9072     }
9073     if {[catch {
9074         if {$a == $lim} {
9075             # finish reading the cache and setting up arctags, etc.
9076             set line [gets $f]
9077             if {$line ne "1"} {error "bad final version"}
9078             close $f
9079             foreach id [array names idtags] {
9080                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9081                     [llength $allparents($id)] == 1} {
9082                     set a [lindex $arcnos($id) 0]
9083                     if {$arctags($a) eq {}} {
9084                         recalcarc $a
9085                     }
9086                 }
9087             }
9088             foreach id [array names idheads] {
9089                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9090                     [llength $allparents($id)] == 1} {
9091                     set a [lindex $arcnos($id) 0]
9092                     if {$archeads($a) eq {}} {
9093                         recalcarc $a
9094                     }
9095                 }
9096             }
9097             foreach id [lsort -unique $possible_seeds] {
9098                 if {$arcnos($id) eq {}} {
9099                     lappend seeds $id
9100                 }
9101             }
9102             set allcwait 0
9103         } else {
9104             while {[incr a] <= $lim} {
9105                 set line [gets $f]
9106                 if {[llength $line] != 3} {error "bad line"}
9107                 set s [lindex $line 0]
9108                 set arcstart($a) $s
9109                 lappend arcout($s) $a
9110                 if {![info exists arcnos($s)]} {
9111                     lappend possible_seeds $s
9112                     set arcnos($s) {}
9113                 }
9114                 set e [lindex $line 1]
9115                 if {$e eq {}} {
9116                     set growing($a) 1
9117                 } else {
9118                     set arcend($a) $e
9119                     if {![info exists arcout($e)]} {
9120                         set arcout($e) {}
9121                     }
9122                 }
9123                 set arcids($a) [lindex $line 2]
9124                 foreach id $arcids($a) {
9125                     lappend allparents($s) $id
9126                     set s $id
9127                     lappend arcnos($id) $a
9128                 }
9129                 if {![info exists allparents($s)]} {
9130                     set allparents($s) {}
9131                 }
9132                 set arctags($a) {}
9133                 set archeads($a) {}
9134             }
9135             set nextarc [expr {$a - 1}]
9136         }
9137     } err]} {
9138         dropcache $err
9139         return 0
9140     }
9141     if {!$allcwait} {
9142         getallcommits
9143     }
9144     return $allcwait
9145 }
9146
9147 proc getcache {f} {
9148     global nextarc cachedarcs possible_seeds
9149
9150     if {[catch {
9151         set line [gets $f]
9152         if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
9153         # make sure it's an integer
9154         set cachedarcs [expr {int([lindex $line 1])}]
9155         if {$cachedarcs < 0} {error "bad number of arcs"}
9156         set nextarc 0
9157         set possible_seeds {}
9158         run readcache $f
9159     } err]} {
9160         dropcache $err
9161     }
9162     return 0
9163 }
9164
9165 proc dropcache {err} {
9166     global allcwait nextarc cachedarcs seeds
9167
9168     #puts "dropping cache ($err)"
9169     foreach v {arcnos arcout arcids arcstart arcend growing \
9170                    arctags archeads allparents allchildren} {
9171         global $v
9172         catch {unset $v}
9173     }
9174     set allcwait 0
9175     set nextarc 0
9176     set cachedarcs 0
9177     set seeds {}
9178     getallcommits
9179 }
9180
9181 proc writecache {f} {
9182     global cachearc cachedarcs allccache
9183     global arcstart arcend arcnos arcids arcout
9184
9185     set a $cachearc
9186     set lim $cachedarcs
9187     if {$lim - $a > 1000} {
9188         set lim [expr {$a + 1000}]
9189     }
9190     if {[catch {
9191         while {[incr a] <= $lim} {
9192             if {[info exists arcend($a)]} {
9193                 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
9194             } else {
9195                 puts $f [list $arcstart($a) {} $arcids($a)]
9196             }
9197         }
9198     } err]} {
9199         catch {close $f}
9200         catch {file delete $allccache}
9201         #puts "writing cache failed ($err)"
9202         return 0
9203     }
9204     set cachearc [expr {$a - 1}]
9205     if {$a > $cachedarcs} {
9206         puts $f "1"
9207         close $f
9208         return 0
9209     }
9210     return 1
9211 }
9212
9213 proc savecache {} {
9214     global nextarc cachedarcs cachearc allccache
9215
9216     if {$nextarc == $cachedarcs} return
9217     set cachearc 0
9218     set cachedarcs $nextarc
9219     catch {
9220         set f [open $allccache w]
9221         puts $f [list 1 $cachedarcs]
9222         run writecache $f
9223     }
9224 }
9225
9226 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
9227 # or 0 if neither is true.
9228 proc anc_or_desc {a b} {
9229     global arcout arcstart arcend arcnos cached_isanc
9230
9231     if {$arcnos($a) eq $arcnos($b)} {
9232         # Both are on the same arc(s); either both are the same BMP,
9233         # or if one is not a BMP, the other is also not a BMP or is
9234         # the BMP at end of the arc (and it only has 1 incoming arc).
9235         # Or both can be BMPs with no incoming arcs.
9236         if {$a eq $b || $arcnos($a) eq {}} {
9237             return 0
9238         }
9239         # assert {[llength $arcnos($a)] == 1}
9240         set arc [lindex $arcnos($a) 0]
9241         set i [lsearch -exact $arcids($arc) $a]
9242         set j [lsearch -exact $arcids($arc) $b]
9243         if {$i < 0 || $i > $j} {
9244             return 1
9245         } else {
9246             return -1
9247         }
9248     }
9249
9250     if {![info exists arcout($a)]} {
9251         set arc [lindex $arcnos($a) 0]
9252         if {[info exists arcend($arc)]} {
9253             set aend $arcend($arc)
9254         } else {
9255             set aend {}
9256         }
9257         set a $arcstart($arc)
9258     } else {
9259         set aend $a
9260     }
9261     if {![info exists arcout($b)]} {
9262         set arc [lindex $arcnos($b) 0]
9263         if {[info exists arcend($arc)]} {
9264             set bend $arcend($arc)
9265         } else {
9266             set bend {}
9267         }
9268         set b $arcstart($arc)
9269     } else {
9270         set bend $b
9271     }
9272     if {$a eq $bend} {
9273         return 1
9274     }
9275     if {$b eq $aend} {
9276         return -1
9277     }
9278     if {[info exists cached_isanc($a,$bend)]} {
9279         if {$cached_isanc($a,$bend)} {
9280             return 1
9281         }
9282     }
9283     if {[info exists cached_isanc($b,$aend)]} {
9284         if {$cached_isanc($b,$aend)} {
9285             return -1
9286         }
9287         if {[info exists cached_isanc($a,$bend)]} {
9288             return 0
9289         }
9290     }
9291
9292     set todo [list $a $b]
9293     set anc($a) a
9294     set anc($b) b
9295     for {set i 0} {$i < [llength $todo]} {incr i} {
9296         set x [lindex $todo $i]
9297         if {$anc($x) eq {}} {
9298             continue
9299         }
9300         foreach arc $arcnos($x) {
9301             set xd $arcstart($arc)
9302             if {$xd eq $bend} {
9303                 set cached_isanc($a,$bend) 1
9304                 set cached_isanc($b,$aend) 0
9305                 return 1
9306             } elseif {$xd eq $aend} {
9307                 set cached_isanc($b,$aend) 1
9308                 set cached_isanc($a,$bend) 0
9309                 return -1
9310             }
9311             if {![info exists anc($xd)]} {
9312                 set anc($xd) $anc($x)
9313                 lappend todo $xd
9314             } elseif {$anc($xd) ne $anc($x)} {
9315                 set anc($xd) {}
9316             }
9317         }
9318     }
9319     set cached_isanc($a,$bend) 0
9320     set cached_isanc($b,$aend) 0
9321     return 0
9322 }
9323
9324 # This identifies whether $desc has an ancestor that is
9325 # a growing tip of the graph and which is not an ancestor of $anc
9326 # and returns 0 if so and 1 if not.
9327 # If we subsequently discover a tag on such a growing tip, and that
9328 # turns out to be a descendent of $anc (which it could, since we
9329 # don't necessarily see children before parents), then $desc
9330 # isn't a good choice to display as a descendent tag of
9331 # $anc (since it is the descendent of another tag which is
9332 # a descendent of $anc).  Similarly, $anc isn't a good choice to
9333 # display as a ancestor tag of $desc.
9334 #
9335 proc is_certain {desc anc} {
9336     global arcnos arcout arcstart arcend growing problems
9337
9338     set certain {}
9339     if {[llength $arcnos($anc)] == 1} {
9340         # tags on the same arc are certain
9341         if {$arcnos($desc) eq $arcnos($anc)} {
9342             return 1
9343         }
9344         if {![info exists arcout($anc)]} {
9345             # if $anc is partway along an arc, use the start of the arc instead
9346             set a [lindex $arcnos($anc) 0]
9347             set anc $arcstart($a)
9348         }
9349     }
9350     if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
9351         set x $desc
9352     } else {
9353         set a [lindex $arcnos($desc) 0]
9354         set x $arcend($a)
9355     }
9356     if {$x == $anc} {
9357         return 1
9358     }
9359     set anclist [list $x]
9360     set dl($x) 1
9361     set nnh 1
9362     set ngrowanc 0
9363     for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
9364         set x [lindex $anclist $i]
9365         if {$dl($x)} {
9366             incr nnh -1
9367         }
9368         set done($x) 1
9369         foreach a $arcout($x) {
9370             if {[info exists growing($a)]} {
9371                 if {![info exists growanc($x)] && $dl($x)} {
9372                     set growanc($x) 1
9373                     incr ngrowanc
9374                 }
9375             } else {
9376                 set y $arcend($a)
9377                 if {[info exists dl($y)]} {
9378                     if {$dl($y)} {
9379                         if {!$dl($x)} {
9380                             set dl($y) 0
9381                             if {![info exists done($y)]} {
9382                                 incr nnh -1
9383                             }
9384                             if {[info exists growanc($x)]} {
9385                                 incr ngrowanc -1
9386                             }
9387                             set xl [list $y]
9388                             for {set k 0} {$k < [llength $xl]} {incr k} {
9389                                 set z [lindex $xl $k]
9390                                 foreach c $arcout($z) {
9391                                     if {[info exists arcend($c)]} {
9392                                         set v $arcend($c)
9393                                         if {[info exists dl($v)] && $dl($v)} {
9394                                             set dl($v) 0
9395                                             if {![info exists done($v)]} {
9396                                                 incr nnh -1
9397                                             }
9398                                             if {[info exists growanc($v)]} {
9399                                                 incr ngrowanc -1
9400                                             }
9401                                             lappend xl $v
9402                                         }
9403                                     }
9404                                 }
9405                             }
9406                         }
9407                     }
9408                 } elseif {$y eq $anc || !$dl($x)} {
9409                     set dl($y) 0
9410                     lappend anclist $y
9411                 } else {
9412                     set dl($y) 1
9413                     lappend anclist $y
9414                     incr nnh
9415                 }
9416             }
9417         }
9418     }
9419     foreach x [array names growanc] {
9420         if {$dl($x)} {
9421             return 0
9422         }
9423         return 0
9424     }
9425     return 1
9426 }
9427
9428 proc validate_arctags {a} {
9429     global arctags idtags
9430
9431     set i -1
9432     set na $arctags($a)
9433     foreach id $arctags($a) {
9434         incr i
9435         if {![info exists idtags($id)]} {
9436             set na [lreplace $na $i $i]
9437             incr i -1
9438         }
9439     }
9440     set arctags($a) $na
9441 }
9442
9443 proc validate_archeads {a} {
9444     global archeads idheads
9445
9446     set i -1
9447     set na $archeads($a)
9448     foreach id $archeads($a) {
9449         incr i
9450         if {![info exists idheads($id)]} {
9451             set na [lreplace $na $i $i]
9452             incr i -1
9453         }
9454     }
9455     set archeads($a) $na
9456 }
9457
9458 # Return the list of IDs that have tags that are descendents of id,
9459 # ignoring IDs that are descendents of IDs already reported.
9460 proc desctags {id} {
9461     global arcnos arcstart arcids arctags idtags allparents
9462     global growing cached_dtags
9463
9464     if {![info exists allparents($id)]} {
9465         return {}
9466     }
9467     set t1 [clock clicks -milliseconds]
9468     set argid $id
9469     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9470         # part-way along an arc; check that arc first
9471         set a [lindex $arcnos($id) 0]
9472         if {$arctags($a) ne {}} {
9473             validate_arctags $a
9474             set i [lsearch -exact $arcids($a) $id]
9475             set tid {}
9476             foreach t $arctags($a) {
9477                 set j [lsearch -exact $arcids($a) $t]
9478                 if {$j >= $i} break
9479                 set tid $t
9480             }
9481             if {$tid ne {}} {
9482                 return $tid
9483             }
9484         }
9485         set id $arcstart($a)
9486         if {[info exists idtags($id)]} {
9487             return $id
9488         }
9489     }
9490     if {[info exists cached_dtags($id)]} {
9491         return $cached_dtags($id)
9492     }
9493
9494     set origid $id
9495     set todo [list $id]
9496     set queued($id) 1
9497     set nc 1
9498     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
9499         set id [lindex $todo $i]
9500         set done($id) 1
9501         set ta [info exists hastaggedancestor($id)]
9502         if {!$ta} {
9503             incr nc -1
9504         }
9505         # ignore tags on starting node
9506         if {!$ta && $i > 0} {
9507             if {[info exists idtags($id)]} {
9508                 set tagloc($id) $id
9509                 set ta 1
9510             } elseif {[info exists cached_dtags($id)]} {
9511                 set tagloc($id) $cached_dtags($id)
9512                 set ta 1
9513             }
9514         }
9515         foreach a $arcnos($id) {
9516             set d $arcstart($a)
9517             if {!$ta && $arctags($a) ne {}} {
9518                 validate_arctags $a
9519                 if {$arctags($a) ne {}} {
9520                     lappend tagloc($id) [lindex $arctags($a) end]
9521                 }
9522             }
9523             if {$ta || $arctags($a) ne {}} {
9524                 set tomark [list $d]
9525                 for {set j 0} {$j < [llength $tomark]} {incr j} {
9526                     set dd [lindex $tomark $j]
9527                     if {![info exists hastaggedancestor($dd)]} {
9528                         if {[info exists done($dd)]} {
9529                             foreach b $arcnos($dd) {
9530                                 lappend tomark $arcstart($b)
9531                             }
9532                             if {[info exists tagloc($dd)]} {
9533                                 unset tagloc($dd)
9534                             }
9535                         } elseif {[info exists queued($dd)]} {
9536                             incr nc -1
9537                         }
9538                         set hastaggedancestor($dd) 1
9539                     }
9540                 }
9541             }
9542             if {![info exists queued($d)]} {
9543                 lappend todo $d
9544                 set queued($d) 1
9545                 if {![info exists hastaggedancestor($d)]} {
9546                     incr nc
9547                 }
9548             }
9549         }
9550     }
9551     set tags {}
9552     foreach id [array names tagloc] {
9553         if {![info exists hastaggedancestor($id)]} {
9554             foreach t $tagloc($id) {
9555                 if {[lsearch -exact $tags $t] < 0} {
9556                     lappend tags $t
9557                 }
9558             }
9559         }
9560     }
9561     set t2 [clock clicks -milliseconds]
9562     set loopix $i
9563
9564     # remove tags that are descendents of other tags
9565     for {set i 0} {$i < [llength $tags]} {incr i} {
9566         set a [lindex $tags $i]
9567         for {set j 0} {$j < $i} {incr j} {
9568             set b [lindex $tags $j]
9569             set r [anc_or_desc $a $b]
9570             if {$r == 1} {
9571                 set tags [lreplace $tags $j $j]
9572                 incr j -1
9573                 incr i -1
9574             } elseif {$r == -1} {
9575                 set tags [lreplace $tags $i $i]
9576                 incr i -1
9577                 break
9578             }
9579         }
9580     }
9581
9582     if {[array names growing] ne {}} {
9583         # graph isn't finished, need to check if any tag could get
9584         # eclipsed by another tag coming later.  Simply ignore any
9585         # tags that could later get eclipsed.
9586         set ctags {}
9587         foreach t $tags {
9588             if {[is_certain $t $origid]} {
9589                 lappend ctags $t
9590             }
9591         }
9592         if {$tags eq $ctags} {
9593             set cached_dtags($origid) $tags
9594         } else {
9595             set tags $ctags
9596         }
9597     } else {
9598         set cached_dtags($origid) $tags
9599     }
9600     set t3 [clock clicks -milliseconds]
9601     if {0 && $t3 - $t1 >= 100} {
9602         puts "iterating descendents ($loopix/[llength $todo] nodes) took\
9603             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
9604     }
9605     return $tags
9606 }
9607
9608 proc anctags {id} {
9609     global arcnos arcids arcout arcend arctags idtags allparents
9610     global growing cached_atags
9611
9612     if {![info exists allparents($id)]} {
9613         return {}
9614     }
9615     set t1 [clock clicks -milliseconds]
9616     set argid $id
9617     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9618         # part-way along an arc; check that arc first
9619         set a [lindex $arcnos($id) 0]
9620         if {$arctags($a) ne {}} {
9621             validate_arctags $a
9622             set i [lsearch -exact $arcids($a) $id]
9623             foreach t $arctags($a) {
9624                 set j [lsearch -exact $arcids($a) $t]
9625                 if {$j > $i} {
9626                     return $t
9627                 }
9628             }
9629         }
9630         if {![info exists arcend($a)]} {
9631             return {}
9632         }
9633         set id $arcend($a)
9634         if {[info exists idtags($id)]} {
9635             return $id
9636         }
9637     }
9638     if {[info exists cached_atags($id)]} {
9639         return $cached_atags($id)
9640     }
9641
9642     set origid $id
9643     set todo [list $id]
9644     set queued($id) 1
9645     set taglist {}
9646     set nc 1
9647     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
9648         set id [lindex $todo $i]
9649         set done($id) 1
9650         set td [info exists hastaggeddescendent($id)]
9651         if {!$td} {
9652             incr nc -1
9653         }
9654         # ignore tags on starting node
9655         if {!$td && $i > 0} {
9656             if {[info exists idtags($id)]} {
9657                 set tagloc($id) $id
9658                 set td 1
9659             } elseif {[info exists cached_atags($id)]} {
9660                 set tagloc($id) $cached_atags($id)
9661                 set td 1
9662             }
9663         }
9664         foreach a $arcout($id) {
9665             if {!$td && $arctags($a) ne {}} {
9666                 validate_arctags $a
9667                 if {$arctags($a) ne {}} {
9668                     lappend tagloc($id) [lindex $arctags($a) 0]
9669                 }
9670             }
9671             if {![info exists arcend($a)]} continue
9672             set d $arcend($a)
9673             if {$td || $arctags($a) ne {}} {
9674                 set tomark [list $d]
9675                 for {set j 0} {$j < [llength $tomark]} {incr j} {
9676                     set dd [lindex $tomark $j]
9677                     if {![info exists hastaggeddescendent($dd)]} {
9678                         if {[info exists done($dd)]} {
9679                             foreach b $arcout($dd) {
9680                                 if {[info exists arcend($b)]} {
9681                                     lappend tomark $arcend($b)
9682                                 }
9683                             }
9684                             if {[info exists tagloc($dd)]} {
9685                                 unset tagloc($dd)
9686                             }
9687                         } elseif {[info exists queued($dd)]} {
9688                             incr nc -1
9689                         }
9690                         set hastaggeddescendent($dd) 1
9691                     }
9692                 }
9693             }
9694             if {![info exists queued($d)]} {
9695                 lappend todo $d
9696                 set queued($d) 1
9697                 if {![info exists hastaggeddescendent($d)]} {
9698                     incr nc
9699                 }
9700             }
9701         }
9702     }
9703     set t2 [clock clicks -milliseconds]
9704     set loopix $i
9705     set tags {}
9706     foreach id [array names tagloc] {
9707         if {![info exists hastaggeddescendent($id)]} {
9708             foreach t $tagloc($id) {
9709                 if {[lsearch -exact $tags $t] < 0} {
9710                     lappend tags $t
9711                 }
9712             }
9713         }
9714     }
9715
9716     # remove tags that are ancestors of other tags
9717     for {set i 0} {$i < [llength $tags]} {incr i} {
9718         set a [lindex $tags $i]
9719         for {set j 0} {$j < $i} {incr j} {
9720             set b [lindex $tags $j]
9721             set r [anc_or_desc $a $b]
9722             if {$r == -1} {
9723                 set tags [lreplace $tags $j $j]
9724                 incr j -1
9725                 incr i -1
9726             } elseif {$r == 1} {
9727                 set tags [lreplace $tags $i $i]
9728                 incr i -1
9729                 break
9730             }
9731         }
9732     }
9733
9734     if {[array names growing] ne {}} {
9735         # graph isn't finished, need to check if any tag could get
9736         # eclipsed by another tag coming later.  Simply ignore any
9737         # tags that could later get eclipsed.
9738         set ctags {}
9739         foreach t $tags {
9740             if {[is_certain $origid $t]} {
9741                 lappend ctags $t
9742             }
9743         }
9744         if {$tags eq $ctags} {
9745             set cached_atags($origid) $tags
9746         } else {
9747             set tags $ctags
9748         }
9749     } else {
9750         set cached_atags($origid) $tags
9751     }
9752     set t3 [clock clicks -milliseconds]
9753     if {0 && $t3 - $t1 >= 100} {
9754         puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
9755             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
9756     }
9757     return $tags
9758 }
9759
9760 # Return the list of IDs that have heads that are descendents of id,
9761 # including id itself if it has a head.
9762 proc descheads {id} {
9763     global arcnos arcstart arcids archeads idheads cached_dheads
9764     global allparents
9765
9766     if {![info exists allparents($id)]} {
9767         return {}
9768     }
9769     set aret {}
9770     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9771         # part-way along an arc; check it first
9772         set a [lindex $arcnos($id) 0]
9773         if {$archeads($a) ne {}} {
9774             validate_archeads $a
9775             set i [lsearch -exact $arcids($a) $id]
9776             foreach t $archeads($a) {
9777                 set j [lsearch -exact $arcids($a) $t]
9778                 if {$j > $i} break
9779                 lappend aret $t
9780             }
9781         }
9782         set id $arcstart($a)
9783     }
9784     set origid $id
9785     set todo [list $id]
9786     set seen($id) 1
9787     set ret {}
9788     for {set i 0} {$i < [llength $todo]} {incr i} {
9789         set id [lindex $todo $i]
9790         if {[info exists cached_dheads($id)]} {
9791             set ret [concat $ret $cached_dheads($id)]
9792         } else {
9793             if {[info exists idheads($id)]} {
9794                 lappend ret $id
9795             }
9796             foreach a $arcnos($id) {
9797                 if {$archeads($a) ne {}} {
9798                     validate_archeads $a
9799                     if {$archeads($a) ne {}} {
9800                         set ret [concat $ret $archeads($a)]
9801                     }
9802                 }
9803                 set d $arcstart($a)
9804                 if {![info exists seen($d)]} {
9805                     lappend todo $d
9806                     set seen($d) 1
9807                 }
9808             }
9809         }
9810     }
9811     set ret [lsort -unique $ret]
9812     set cached_dheads($origid) $ret
9813     return [concat $ret $aret]
9814 }
9815
9816 proc addedtag {id} {
9817     global arcnos arcout cached_dtags cached_atags
9818
9819     if {![info exists arcnos($id)]} return
9820     if {![info exists arcout($id)]} {
9821         recalcarc [lindex $arcnos($id) 0]
9822     }
9823     catch {unset cached_dtags}
9824     catch {unset cached_atags}
9825 }
9826
9827 proc addedhead {hid head} {
9828     global arcnos arcout cached_dheads
9829
9830     if {![info exists arcnos($hid)]} return
9831     if {![info exists arcout($hid)]} {
9832         recalcarc [lindex $arcnos($hid) 0]
9833     }
9834     catch {unset cached_dheads}
9835 }
9836
9837 proc removedhead {hid head} {
9838     global cached_dheads
9839
9840     catch {unset cached_dheads}
9841 }
9842
9843 proc movedhead {hid head} {
9844     global arcnos arcout cached_dheads
9845
9846     if {![info exists arcnos($hid)]} return
9847     if {![info exists arcout($hid)]} {
9848         recalcarc [lindex $arcnos($hid) 0]
9849     }
9850     catch {unset cached_dheads}
9851 }
9852
9853 proc changedrefs {} {
9854     global cached_dheads cached_dtags cached_atags
9855     global arctags archeads arcnos arcout idheads idtags
9856
9857     foreach id [concat [array names idheads] [array names idtags]] {
9858         if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
9859             set a [lindex $arcnos($id) 0]
9860             if {![info exists donearc($a)]} {
9861                 recalcarc $a
9862                 set donearc($a) 1
9863             }
9864         }
9865     }
9866     catch {unset cached_dtags}
9867     catch {unset cached_atags}
9868     catch {unset cached_dheads}
9869 }
9870
9871 proc rereadrefs {} {
9872     global idtags idheads idotherrefs mainheadid
9873
9874     set refids [concat [array names idtags] \
9875                     [array names idheads] [array names idotherrefs]]
9876     foreach id $refids {
9877         if {![info exists ref($id)]} {
9878             set ref($id) [listrefs $id]
9879         }
9880     }
9881     set oldmainhead $mainheadid
9882     readrefs
9883     changedrefs
9884     set refids [lsort -unique [concat $refids [array names idtags] \
9885                         [array names idheads] [array names idotherrefs]]]
9886     foreach id $refids {
9887         set v [listrefs $id]
9888         if {![info exists ref($id)] || $ref($id) != $v} {
9889             redrawtags $id
9890         }
9891     }
9892     if {$oldmainhead ne $mainheadid} {
9893         redrawtags $oldmainhead
9894         redrawtags $mainheadid
9895     }
9896     run refill_reflist
9897 }
9898
9899 proc listrefs {id} {
9900     global idtags idheads idotherrefs
9901
9902     set x {}
9903     if {[info exists idtags($id)]} {
9904         set x $idtags($id)
9905     }
9906     set y {}
9907     if {[info exists idheads($id)]} {
9908         set y $idheads($id)
9909     }
9910     set z {}
9911     if {[info exists idotherrefs($id)]} {
9912         set z $idotherrefs($id)
9913     }
9914     return [list $x $y $z]
9915 }
9916
9917 proc showtag {tag isnew} {
9918     global ctext tagcontents tagids linknum tagobjid
9919
9920     if {$isnew} {
9921         addtohistory [list showtag $tag 0]
9922     }
9923     $ctext conf -state normal
9924     clear_ctext
9925     settabs 0
9926     set linknum 0
9927     if {![info exists tagcontents($tag)]} {
9928         catch {
9929             set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
9930         }
9931     }
9932     if {[info exists tagcontents($tag)]} {
9933         set text $tagcontents($tag)
9934     } else {
9935         set text "[mc "Tag"]: $tag\n[mc "Id"]:  $tagids($tag)"
9936     }
9937     appendwithlinks $text {}
9938     $ctext conf -state disabled
9939     init_flist {}
9940 }
9941
9942 proc doquit {} {
9943     global stopped
9944     global gitktmpdir
9945
9946     set stopped 100
9947     savestuff .
9948     destroy .
9949
9950     if {[info exists gitktmpdir]} {
9951         catch {file delete -force $gitktmpdir}
9952     }
9953 }
9954
9955 proc mkfontdisp {font top which} {
9956     global fontattr fontpref $font
9957
9958     set fontpref($font) [set $font]
9959     button $top.${font}but -text $which -font optionfont \
9960         -command [list choosefont $font $which]
9961     label $top.$font -relief flat -font $font \
9962         -text $fontattr($font,family) -justify left
9963     grid x $top.${font}but $top.$font -sticky w
9964 }
9965
9966 proc choosefont {font which} {
9967     global fontparam fontlist fonttop fontattr
9968     global prefstop
9969
9970     set fontparam(which) $which
9971     set fontparam(font) $font
9972     set fontparam(family) [font actual $font -family]
9973     set fontparam(size) $fontattr($font,size)
9974     set fontparam(weight) $fontattr($font,weight)
9975     set fontparam(slant) $fontattr($font,slant)
9976     set top .gitkfont
9977     set fonttop $top
9978     if {![winfo exists $top]} {
9979         font create sample
9980         eval font config sample [font actual $font]
9981         toplevel $top
9982         make_transient $top $prefstop
9983         wm title $top [mc "Gitk font chooser"]
9984         label $top.l -textvariable fontparam(which)
9985         pack $top.l -side top
9986         set fontlist [lsort [font families]]
9987         frame $top.f
9988         listbox $top.f.fam -listvariable fontlist \
9989             -yscrollcommand [list $top.f.sb set]
9990         bind $top.f.fam <<ListboxSelect>> selfontfam
9991         scrollbar $top.f.sb -command [list $top.f.fam yview]
9992         pack $top.f.sb -side right -fill y
9993         pack $top.f.fam -side left -fill both -expand 1
9994         pack $top.f -side top -fill both -expand 1
9995         frame $top.g
9996         spinbox $top.g.size -from 4 -to 40 -width 4 \
9997             -textvariable fontparam(size) \
9998             -validatecommand {string is integer -strict %s}
9999         checkbutton $top.g.bold -padx 5 \
10000             -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
10001             -variable fontparam(weight) -onvalue bold -offvalue normal
10002         checkbutton $top.g.ital -padx 5 \
10003             -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
10004             -variable fontparam(slant) -onvalue italic -offvalue roman
10005         pack $top.g.size $top.g.bold $top.g.ital -side left
10006         pack $top.g -side top
10007         canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
10008             -background white
10009         $top.c create text 100 25 -anchor center -text $which -font sample \
10010             -fill black -tags text
10011         bind $top.c <Configure> [list centertext $top.c]
10012         pack $top.c -side top -fill x
10013         frame $top.buts
10014         button $top.buts.ok -text [mc "OK"] -command fontok -default active
10015         button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
10016         bind $top <Key-Return> fontok
10017         bind $top <Key-Escape> fontcan
10018         grid $top.buts.ok $top.buts.can
10019         grid columnconfigure $top.buts 0 -weight 1 -uniform a
10020         grid columnconfigure $top.buts 1 -weight 1 -uniform a
10021         pack $top.buts -side bottom -fill x
10022         trace add variable fontparam write chg_fontparam
10023     } else {
10024         raise $top
10025         $top.c itemconf text -text $which
10026     }
10027     set i [lsearch -exact $fontlist $fontparam(family)]
10028     if {$i >= 0} {
10029         $top.f.fam selection set $i
10030         $top.f.fam see $i
10031     }
10032 }
10033
10034 proc centertext {w} {
10035     $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
10036 }
10037
10038 proc fontok {} {
10039     global fontparam fontpref prefstop
10040
10041     set f $fontparam(font)
10042     set fontpref($f) [list $fontparam(family) $fontparam(size)]
10043     if {$fontparam(weight) eq "bold"} {
10044         lappend fontpref($f) "bold"
10045     }
10046     if {$fontparam(slant) eq "italic"} {
10047         lappend fontpref($f) "italic"
10048     }
10049     set w $prefstop.$f
10050     $w conf -text $fontparam(family) -font $fontpref($f)
10051
10052     fontcan
10053 }
10054
10055 proc fontcan {} {
10056     global fonttop fontparam
10057
10058     if {[info exists fonttop]} {
10059         catch {destroy $fonttop}
10060         catch {font delete sample}
10061         unset fonttop
10062         unset fontparam
10063     }
10064 }
10065
10066 proc selfontfam {} {
10067     global fonttop fontparam
10068
10069     set i [$fonttop.f.fam curselection]
10070     if {$i ne {}} {
10071         set fontparam(family) [$fonttop.f.fam get $i]
10072     }
10073 }
10074
10075 proc chg_fontparam {v sub op} {
10076     global fontparam
10077
10078     font config sample -$sub $fontparam($sub)
10079 }
10080
10081 proc doprefs {} {
10082     global maxwidth maxgraphpct
10083     global oldprefs prefstop showneartags showlocalchanges
10084     global bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
10085     global tabstop limitdiffs autoselect extdifftool perfile_attrs
10086
10087     set top .gitkprefs
10088     set prefstop $top
10089     if {[winfo exists $top]} {
10090         raise $top
10091         return
10092     }
10093     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
10094                    limitdiffs tabstop perfile_attrs} {
10095         set oldprefs($v) [set $v]
10096     }
10097     toplevel $top
10098     wm title $top [mc "Gitk preferences"]
10099     make_transient $top .
10100     label $top.ldisp -text [mc "Commit list display options"]
10101     grid $top.ldisp - -sticky w -pady 10
10102     label $top.spacer -text " "
10103     label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
10104         -font optionfont
10105     spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
10106     grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
10107     label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
10108         -font optionfont
10109     spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
10110     grid x $top.maxpctl $top.maxpct -sticky w
10111     checkbutton $top.showlocal -text [mc "Show local changes"] \
10112         -font optionfont -variable showlocalchanges
10113     grid x $top.showlocal -sticky w
10114     checkbutton $top.autoselect -text [mc "Auto-select SHA1"] \
10115         -font optionfont -variable autoselect
10116     grid x $top.autoselect -sticky w
10117
10118     label $top.ddisp -text [mc "Diff display options"]
10119     grid $top.ddisp - -sticky w -pady 10
10120     label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
10121     spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
10122     grid x $top.tabstopl $top.tabstop -sticky w
10123     checkbutton $top.ntag -text [mc "Display nearby tags"] \
10124         -font optionfont -variable showneartags
10125     grid x $top.ntag -sticky w
10126     checkbutton $top.ldiff -text [mc "Limit diffs to listed paths"] \
10127         -font optionfont -variable limitdiffs
10128     grid x $top.ldiff -sticky w
10129     checkbutton $top.lattr -text [mc "Support per-file encodings"] \
10130         -font optionfont -variable perfile_attrs
10131     grid x $top.lattr -sticky w
10132
10133     entry $top.extdifft -textvariable extdifftool
10134     frame $top.extdifff
10135     label $top.extdifff.l -text [mc "External diff tool" ] -font optionfont \
10136         -padx 10
10137     button $top.extdifff.b -text [mc "Choose..."] -font optionfont \
10138         -command choose_extdiff
10139     pack $top.extdifff.l $top.extdifff.b -side left
10140     grid x $top.extdifff $top.extdifft -sticky w
10141
10142     label $top.cdisp -text [mc "Colors: press to choose"]
10143     grid $top.cdisp - -sticky w -pady 10
10144     label $top.bg -padx 40 -relief sunk -background $bgcolor
10145     button $top.bgbut -text [mc "Background"] -font optionfont \
10146         -command [list choosecolor bgcolor {} $top.bg [mc "background"] setbg]
10147     grid x $top.bgbut $top.bg -sticky w
10148     label $top.fg -padx 40 -relief sunk -background $fgcolor
10149     button $top.fgbut -text [mc "Foreground"] -font optionfont \
10150         -command [list choosecolor fgcolor {} $top.fg [mc "foreground"] setfg]
10151     grid x $top.fgbut $top.fg -sticky w
10152     label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
10153     button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
10154         -command [list choosecolor diffcolors 0 $top.diffold [mc "diff old lines"] \
10155                       [list $ctext tag conf d0 -foreground]]
10156     grid x $top.diffoldbut $top.diffold -sticky w
10157     label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
10158     button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
10159         -command [list choosecolor diffcolors 1 $top.diffnew [mc "diff new lines"] \
10160                       [list $ctext tag conf dresult -foreground]]
10161     grid x $top.diffnewbut $top.diffnew -sticky w
10162     label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
10163     button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
10164         -command [list choosecolor diffcolors 2 $top.hunksep \
10165                       [mc "diff hunk header"] \
10166                       [list $ctext tag conf hunksep -foreground]]
10167     grid x $top.hunksepbut $top.hunksep -sticky w
10168     label $top.markbgsep -padx 40 -relief sunk -background $markbgcolor
10169     button $top.markbgbut -text [mc "Marked line bg"] -font optionfont \
10170         -command [list choosecolor markbgcolor {} $top.markbgsep \
10171                       [mc "marked line background"] \
10172                       [list $ctext tag conf omark -background]]
10173     grid x $top.markbgbut $top.markbgsep -sticky w
10174     label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
10175     button $top.selbgbut -text [mc "Select bg"] -font optionfont \
10176         -command [list choosecolor selectbgcolor {} $top.selbgsep [mc "background"] setselbg]
10177     grid x $top.selbgbut $top.selbgsep -sticky w
10178
10179     label $top.cfont -text [mc "Fonts: press to choose"]
10180     grid $top.cfont - -sticky w -pady 10
10181     mkfontdisp mainfont $top [mc "Main font"]
10182     mkfontdisp textfont $top [mc "Diff display font"]
10183     mkfontdisp uifont $top [mc "User interface font"]
10184
10185     frame $top.buts
10186     button $top.buts.ok -text [mc "OK"] -command prefsok -default active
10187     button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
10188     bind $top <Key-Return> prefsok
10189     bind $top <Key-Escape> prefscan
10190     grid $top.buts.ok $top.buts.can
10191     grid columnconfigure $top.buts 0 -weight 1 -uniform a
10192     grid columnconfigure $top.buts 1 -weight 1 -uniform a
10193     grid $top.buts - - -pady 10 -sticky ew
10194     bind $top <Visibility> "focus $top.buts.ok"
10195 }
10196
10197 proc choose_extdiff {} {
10198     global extdifftool
10199
10200     set prog [tk_getOpenFile -title "External diff tool" -multiple false]
10201     if {$prog ne {}} {
10202         set extdifftool $prog
10203     }
10204 }
10205
10206 proc choosecolor {v vi w x cmd} {
10207     global $v
10208
10209     set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
10210                -title [mc "Gitk: choose color for %s" $x]]
10211     if {$c eq {}} return
10212     $w conf -background $c
10213     lset $v $vi $c
10214     eval $cmd $c
10215 }
10216
10217 proc setselbg {c} {
10218     global bglist cflist
10219     foreach w $bglist {
10220         $w configure -selectbackground $c
10221     }
10222     $cflist tag configure highlight \
10223         -background [$cflist cget -selectbackground]
10224     allcanvs itemconf secsel -fill $c
10225 }
10226
10227 proc setbg {c} {
10228     global bglist
10229
10230     foreach w $bglist {
10231         $w conf -background $c
10232     }
10233 }
10234
10235 proc setfg {c} {
10236     global fglist canv
10237
10238     foreach w $fglist {
10239         $w conf -foreground $c
10240     }
10241     allcanvs itemconf text -fill $c
10242     $canv itemconf circle -outline $c
10243 }
10244
10245 proc prefscan {} {
10246     global oldprefs prefstop
10247
10248     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
10249                    limitdiffs tabstop perfile_attrs} {
10250         global $v
10251         set $v $oldprefs($v)
10252     }
10253     catch {destroy $prefstop}
10254     unset prefstop
10255     fontcan
10256 }
10257
10258 proc prefsok {} {
10259     global maxwidth maxgraphpct
10260     global oldprefs prefstop showneartags showlocalchanges
10261     global fontpref mainfont textfont uifont
10262     global limitdiffs treediffs perfile_attrs
10263
10264     catch {destroy $prefstop}
10265     unset prefstop
10266     fontcan
10267     set fontchanged 0
10268     if {$mainfont ne $fontpref(mainfont)} {
10269         set mainfont $fontpref(mainfont)
10270         parsefont mainfont $mainfont
10271         eval font configure mainfont [fontflags mainfont]
10272         eval font configure mainfontbold [fontflags mainfont 1]
10273         setcoords
10274         set fontchanged 1
10275     }
10276     if {$textfont ne $fontpref(textfont)} {
10277         set textfont $fontpref(textfont)
10278         parsefont textfont $textfont
10279         eval font configure textfont [fontflags textfont]
10280         eval font configure textfontbold [fontflags textfont 1]
10281     }
10282     if {$uifont ne $fontpref(uifont)} {
10283         set uifont $fontpref(uifont)
10284         parsefont uifont $uifont
10285         eval font configure uifont [fontflags uifont]
10286     }
10287     settabs
10288     if {$showlocalchanges != $oldprefs(showlocalchanges)} {
10289         if {$showlocalchanges} {
10290             doshowlocalchanges
10291         } else {
10292             dohidelocalchanges
10293         }
10294     }
10295     if {$limitdiffs != $oldprefs(limitdiffs) ||
10296         ($perfile_attrs && !$oldprefs(perfile_attrs))} {
10297         # treediffs elements are limited by path;
10298         # won't have encodings cached if perfile_attrs was just turned on
10299         catch {unset treediffs}
10300     }
10301     if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
10302         || $maxgraphpct != $oldprefs(maxgraphpct)} {
10303         redisplay
10304     } elseif {$showneartags != $oldprefs(showneartags) ||
10305           $limitdiffs != $oldprefs(limitdiffs)} {
10306         reselectline
10307     }
10308 }
10309
10310 proc formatdate {d} {
10311     global datetimeformat
10312     if {$d ne {}} {
10313         set d [clock format $d -format $datetimeformat]
10314     }
10315     return $d
10316 }
10317
10318 # This list of encoding names and aliases is distilled from
10319 # http://www.iana.org/assignments/character-sets.
10320 # Not all of them are supported by Tcl.
10321 set encoding_aliases {
10322     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
10323       ISO646-US US-ASCII us IBM367 cp367 csASCII }
10324     { ISO-10646-UTF-1 csISO10646UTF1 }
10325     { ISO_646.basic:1983 ref csISO646basic1983 }
10326     { INVARIANT csINVARIANT }
10327     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
10328     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
10329     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
10330     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
10331     { NATS-DANO iso-ir-9-1 csNATSDANO }
10332     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
10333     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
10334     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
10335     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
10336     { ISO-2022-KR csISO2022KR }
10337     { EUC-KR csEUCKR }
10338     { ISO-2022-JP csISO2022JP }
10339     { ISO-2022-JP-2 csISO2022JP2 }
10340     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
10341       csISO13JISC6220jp }
10342     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
10343     { IT iso-ir-15 ISO646-IT csISO15Italian }
10344     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
10345     { ES iso-ir-17 ISO646-ES csISO17Spanish }
10346     { greek7-old iso-ir-18 csISO18Greek7Old }
10347     { latin-greek iso-ir-19 csISO19LatinGreek }
10348     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
10349     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
10350     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
10351     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
10352     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
10353     { BS_viewdata iso-ir-47 csISO47BSViewdata }
10354     { INIS iso-ir-49 csISO49INIS }
10355     { INIS-8 iso-ir-50 csISO50INIS8 }
10356     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
10357     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
10358     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
10359     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
10360     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
10361     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
10362       csISO60Norwegian1 }
10363     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
10364     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
10365     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
10366     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
10367     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
10368     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
10369     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
10370     { greek7 iso-ir-88 csISO88Greek7 }
10371     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
10372     { iso-ir-90 csISO90 }
10373     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
10374     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
10375       csISO92JISC62991984b }
10376     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
10377     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
10378     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
10379       csISO95JIS62291984handadd }
10380     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
10381     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
10382     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
10383     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
10384       CP819 csISOLatin1 }
10385     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
10386     { T.61-7bit iso-ir-102 csISO102T617bit }
10387     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
10388     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
10389     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
10390     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
10391     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
10392     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
10393     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
10394     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
10395       arabic csISOLatinArabic }
10396     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
10397     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
10398     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
10399       greek greek8 csISOLatinGreek }
10400     { T.101-G2 iso-ir-128 csISO128T101G2 }
10401     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
10402       csISOLatinHebrew }
10403     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
10404     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
10405     { CSN_369103 iso-ir-139 csISO139CSN369103 }
10406     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
10407     { ISO_6937-2-add iso-ir-142 csISOTextComm }
10408     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
10409     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
10410       csISOLatinCyrillic }
10411     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
10412     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
10413     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
10414     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
10415     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
10416     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
10417     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
10418     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
10419     { ISO_10367-box iso-ir-155 csISO10367Box }
10420     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
10421     { latin-lap lap iso-ir-158 csISO158Lap }
10422     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
10423     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
10424     { us-dk csUSDK }
10425     { dk-us csDKUS }
10426     { JIS_X0201 X0201 csHalfWidthKatakana }
10427     { KSC5636 ISO646-KR csKSC5636 }
10428     { ISO-10646-UCS-2 csUnicode }
10429     { ISO-10646-UCS-4 csUCS4 }
10430     { DEC-MCS dec csDECMCS }
10431     { hp-roman8 roman8 r8 csHPRoman8 }
10432     { macintosh mac csMacintosh }
10433     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
10434       csIBM037 }
10435     { IBM038 EBCDIC-INT cp038 csIBM038 }
10436     { IBM273 CP273 csIBM273 }
10437     { IBM274 EBCDIC-BE CP274 csIBM274 }
10438     { IBM275 EBCDIC-BR cp275 csIBM275 }
10439     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
10440     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
10441     { IBM280 CP280 ebcdic-cp-it csIBM280 }
10442     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
10443     { IBM284 CP284 ebcdic-cp-es csIBM284 }
10444     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
10445     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
10446     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
10447     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
10448     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
10449     { IBM424 cp424 ebcdic-cp-he csIBM424 }
10450     { IBM437 cp437 437 csPC8CodePage437 }
10451     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
10452     { IBM775 cp775 csPC775Baltic }
10453     { IBM850 cp850 850 csPC850Multilingual }
10454     { IBM851 cp851 851 csIBM851 }
10455     { IBM852 cp852 852 csPCp852 }
10456     { IBM855 cp855 855 csIBM855 }
10457     { IBM857 cp857 857 csIBM857 }
10458     { IBM860 cp860 860 csIBM860 }
10459     { IBM861 cp861 861 cp-is csIBM861 }
10460     { IBM862 cp862 862 csPC862LatinHebrew }
10461     { IBM863 cp863 863 csIBM863 }
10462     { IBM864 cp864 csIBM864 }
10463     { IBM865 cp865 865 csIBM865 }
10464     { IBM866 cp866 866 csIBM866 }
10465     { IBM868 CP868 cp-ar csIBM868 }
10466     { IBM869 cp869 869 cp-gr csIBM869 }
10467     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
10468     { IBM871 CP871 ebcdic-cp-is csIBM871 }
10469     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
10470     { IBM891 cp891 csIBM891 }
10471     { IBM903 cp903 csIBM903 }
10472     { IBM904 cp904 904 csIBBM904 }
10473     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
10474     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
10475     { IBM1026 CP1026 csIBM1026 }
10476     { EBCDIC-AT-DE csIBMEBCDICATDE }
10477     { EBCDIC-AT-DE-A csEBCDICATDEA }
10478     { EBCDIC-CA-FR csEBCDICCAFR }
10479     { EBCDIC-DK-NO csEBCDICDKNO }
10480     { EBCDIC-DK-NO-A csEBCDICDKNOA }
10481     { EBCDIC-FI-SE csEBCDICFISE }
10482     { EBCDIC-FI-SE-A csEBCDICFISEA }
10483     { EBCDIC-FR csEBCDICFR }
10484     { EBCDIC-IT csEBCDICIT }
10485     { EBCDIC-PT csEBCDICPT }
10486     { EBCDIC-ES csEBCDICES }
10487     { EBCDIC-ES-A csEBCDICESA }
10488     { EBCDIC-ES-S csEBCDICESS }
10489     { EBCDIC-UK csEBCDICUK }
10490     { EBCDIC-US csEBCDICUS }
10491     { UNKNOWN-8BIT csUnknown8BiT }
10492     { MNEMONIC csMnemonic }
10493     { MNEM csMnem }
10494     { VISCII csVISCII }
10495     { VIQR csVIQR }
10496     { KOI8-R csKOI8R }
10497     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
10498     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
10499     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
10500     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
10501     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
10502     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
10503     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
10504     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
10505     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
10506     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
10507     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
10508     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
10509     { IBM1047 IBM-1047 }
10510     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
10511     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
10512     { UNICODE-1-1 csUnicode11 }
10513     { CESU-8 csCESU-8 }
10514     { BOCU-1 csBOCU-1 }
10515     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
10516     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
10517       l8 }
10518     { ISO-8859-15 ISO_8859-15 Latin-9 }
10519     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
10520     { GBK CP936 MS936 windows-936 }
10521     { JIS_Encoding csJISEncoding }
10522     { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
10523     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
10524       EUC-JP }
10525     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
10526     { ISO-10646-UCS-Basic csUnicodeASCII }
10527     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
10528     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
10529     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
10530     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
10531     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
10532     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
10533     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
10534     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
10535     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
10536     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
10537     { Adobe-Standard-Encoding csAdobeStandardEncoding }
10538     { Ventura-US csVenturaUS }
10539     { Ventura-International csVenturaInternational }
10540     { PC8-Danish-Norwegian csPC8DanishNorwegian }
10541     { PC8-Turkish csPC8Turkish }
10542     { IBM-Symbols csIBMSymbols }
10543     { IBM-Thai csIBMThai }
10544     { HP-Legal csHPLegal }
10545     { HP-Pi-font csHPPiFont }
10546     { HP-Math8 csHPMath8 }
10547     { Adobe-Symbol-Encoding csHPPSMath }
10548     { HP-DeskTop csHPDesktop }
10549     { Ventura-Math csVenturaMath }
10550     { Microsoft-Publishing csMicrosoftPublishing }
10551     { Windows-31J csWindows31J }
10552     { GB2312 csGB2312 }
10553     { Big5 csBig5 }
10554 }
10555
10556 proc tcl_encoding {enc} {
10557     global encoding_aliases tcl_encoding_cache
10558     if {[info exists tcl_encoding_cache($enc)]} {
10559         return $tcl_encoding_cache($enc)
10560     }
10561     set names [encoding names]
10562     set lcnames [string tolower $names]
10563     set enc [string tolower $enc]
10564     set i [lsearch -exact $lcnames $enc]
10565     if {$i < 0} {
10566         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
10567         if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
10568             set i [lsearch -exact $lcnames $encx]
10569         }
10570     }
10571     if {$i < 0} {
10572         foreach l $encoding_aliases {
10573             set ll [string tolower $l]
10574             if {[lsearch -exact $ll $enc] < 0} continue
10575             # look through the aliases for one that tcl knows about
10576             foreach e $ll {
10577                 set i [lsearch -exact $lcnames $e]
10578                 if {$i < 0} {
10579                     if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
10580                         set i [lsearch -exact $lcnames $ex]
10581                     }
10582                 }
10583                 if {$i >= 0} break
10584             }
10585             break
10586         }
10587     }
10588     set tclenc {}
10589     if {$i >= 0} {
10590         set tclenc [lindex $names $i]
10591     }
10592     set tcl_encoding_cache($enc) $tclenc
10593     return $tclenc
10594 }
10595
10596 proc gitattr {path attr default} {
10597     global path_attr_cache
10598     if {[info exists path_attr_cache($attr,$path)]} {
10599         set r $path_attr_cache($attr,$path)
10600     } else {
10601         set r "unspecified"
10602         if {![catch {set line [exec git check-attr $attr -- $path]}]} {
10603             regexp "(.*): encoding: (.*)" $line m f r
10604         }
10605         set path_attr_cache($attr,$path) $r
10606     }
10607     if {$r eq "unspecified"} {
10608         return $default
10609     }
10610     return $r
10611 }
10612
10613 proc cache_gitattr {attr pathlist} {
10614     global path_attr_cache
10615     set newlist {}
10616     foreach path $pathlist {
10617         if {![info exists path_attr_cache($attr,$path)]} {
10618             lappend newlist $path
10619         }
10620     }
10621     set lim 1000
10622     if {[tk windowingsystem] == "win32"} {
10623         # windows has a 32k limit on the arguments to a command...
10624         set lim 30
10625     }
10626     while {$newlist ne {}} {
10627         set head [lrange $newlist 0 [expr {$lim - 1}]]
10628         set newlist [lrange $newlist $lim end]
10629         if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
10630             foreach row [split $rlist "\n"] {
10631                 if {[regexp "(.*): encoding: (.*)" $row m path value]} {
10632                     if {[string index $path 0] eq "\""} {
10633                         set path [encoding convertfrom [lindex $path 0]]
10634                     }
10635                     set path_attr_cache($attr,$path) $value
10636                 }
10637             }
10638         }
10639     }
10640 }
10641
10642 proc get_path_encoding {path} {
10643     global gui_encoding perfile_attrs
10644     set tcl_enc $gui_encoding
10645     if {$path ne {} && $perfile_attrs} {
10646         set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
10647         if {$enc2 ne {}} {
10648             set tcl_enc $enc2
10649         }
10650     }
10651     return $tcl_enc
10652 }
10653
10654 # First check that Tcl/Tk is recent enough
10655 if {[catch {package require Tk 8.4} err]} {
10656     show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
10657                      Gitk requires at least Tcl/Tk 8.4."]
10658     exit 1
10659 }
10660
10661 # defaults...
10662 set wrcomcmd "git diff-tree --stdin -p --pretty"
10663
10664 set gitencoding {}
10665 catch {
10666     set gitencoding [exec git config --get i18n.commitencoding]
10667 }
10668 catch {
10669     set gitencoding [exec git config --get i18n.logoutputencoding]
10670 }
10671 if {$gitencoding == ""} {
10672     set gitencoding "utf-8"
10673 }
10674 set tclencoding [tcl_encoding $gitencoding]
10675 if {$tclencoding == {}} {
10676     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
10677 }
10678
10679 set gui_encoding [encoding system]
10680 catch {
10681     set enc [exec git config --get gui.encoding]
10682     if {$enc ne {}} {
10683         set tclenc [tcl_encoding $enc]
10684         if {$tclenc ne {}} {
10685             set gui_encoding $tclenc
10686         } else {
10687             puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
10688         }
10689     }
10690 }
10691
10692 set mainfont {Helvetica 9}
10693 set textfont {Courier 9}
10694 set uifont {Helvetica 9 bold}
10695 set tabstop 8
10696 set findmergefiles 0
10697 set maxgraphpct 50
10698 set maxwidth 16
10699 set revlistorder 0
10700 set fastdate 0
10701 set uparrowlen 5
10702 set downarrowlen 5
10703 set mingaplen 100
10704 set cmitmode "patch"
10705 set wrapcomment "none"
10706 set showneartags 1
10707 set maxrefs 20
10708 set maxlinelen 200
10709 set showlocalchanges 1
10710 set limitdiffs 1
10711 set datetimeformat "%Y-%m-%d %H:%M:%S"
10712 set autoselect 1
10713 set perfile_attrs 0
10714
10715 set extdifftool "meld"
10716
10717 set colors {green red blue magenta darkgrey brown orange}
10718 set bgcolor white
10719 set fgcolor black
10720 set diffcolors {red "#00a000" blue}
10721 set diffcontext 3
10722 set ignorespace 0
10723 set selectbgcolor gray85
10724 set markbgcolor "#e0e0ff"
10725
10726 set circlecolors {white blue gray blue blue}
10727
10728 # button for popping up context menus
10729 if {[tk windowingsystem] eq "aqua"} {
10730     set ctxbut <Button-2>
10731 } else {
10732     set ctxbut <Button-3>
10733 }
10734
10735 ## For msgcat loading, first locate the installation location.
10736 if { [info exists ::env(GITK_MSGSDIR)] } {
10737     ## Msgsdir was manually set in the environment.
10738     set gitk_msgsdir $::env(GITK_MSGSDIR)
10739 } else {
10740     ## Let's guess the prefix from argv0.
10741     set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
10742     set gitk_libdir [file join $gitk_prefix share gitk lib]
10743     set gitk_msgsdir [file join $gitk_libdir msgs]
10744     unset gitk_prefix
10745 }
10746
10747 ## Internationalization (i18n) through msgcat and gettext. See
10748 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
10749 package require msgcat
10750 namespace import ::msgcat::mc
10751 ## And eventually load the actual message catalog
10752 ::msgcat::mcload $gitk_msgsdir
10753
10754 catch {source ~/.gitk}
10755
10756 font create optionfont -family sans-serif -size -12
10757
10758 parsefont mainfont $mainfont
10759 eval font create mainfont [fontflags mainfont]
10760 eval font create mainfontbold [fontflags mainfont 1]
10761
10762 parsefont textfont $textfont
10763 eval font create textfont [fontflags textfont]
10764 eval font create textfontbold [fontflags textfont 1]
10765
10766 parsefont uifont $uifont
10767 eval font create uifont [fontflags uifont]
10768
10769 setoptions
10770
10771 # check that we can find a .git directory somewhere...
10772 if {[catch {set gitdir [gitdir]}]} {
10773     show_error {} . [mc "Cannot find a git repository here."]
10774     exit 1
10775 }
10776 if {![file isdirectory $gitdir]} {
10777     show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
10778     exit 1
10779 }
10780
10781 set selecthead {}
10782 set selectheadid {}
10783
10784 set revtreeargs {}
10785 set cmdline_files {}
10786 set i 0
10787 set revtreeargscmd {}
10788 foreach arg $argv {
10789     switch -glob -- $arg {
10790         "" { }
10791         "--" {
10792             set cmdline_files [lrange $argv [expr {$i + 1}] end]
10793             break
10794         }
10795         "--select-commit=*" {
10796             set selecthead [string range $arg 16 end]
10797         }
10798         "--argscmd=*" {
10799             set revtreeargscmd [string range $arg 10 end]
10800         }
10801         default {
10802             lappend revtreeargs $arg
10803         }
10804     }
10805     incr i
10806 }
10807
10808 if {$selecthead eq "HEAD"} {
10809     set selecthead {}
10810 }
10811
10812 if {$i >= [llength $argv] && $revtreeargs ne {}} {
10813     # no -- on command line, but some arguments (other than --argscmd)
10814     if {[catch {
10815         set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
10816         set cmdline_files [split $f "\n"]
10817         set n [llength $cmdline_files]
10818         set revtreeargs [lrange $revtreeargs 0 end-$n]
10819         # Unfortunately git rev-parse doesn't produce an error when
10820         # something is both a revision and a filename.  To be consistent
10821         # with git log and git rev-list, check revtreeargs for filenames.
10822         foreach arg $revtreeargs {
10823             if {[file exists $arg]} {
10824                 show_error {} . [mc "Ambiguous argument '%s': both revision\
10825                                  and filename" $arg]
10826                 exit 1
10827             }
10828         }
10829     } err]} {
10830         # unfortunately we get both stdout and stderr in $err,
10831         # so look for "fatal:".
10832         set i [string first "fatal:" $err]
10833         if {$i > 0} {
10834             set err [string range $err [expr {$i + 6}] end]
10835         }
10836         show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
10837         exit 1
10838     }
10839 }
10840
10841 set nullid "0000000000000000000000000000000000000000"
10842 set nullid2 "0000000000000000000000000000000000000001"
10843 set nullfile "/dev/null"
10844
10845 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
10846
10847 set runq {}
10848 set history {}
10849 set historyindex 0
10850 set fh_serial 0
10851 set nhl_names {}
10852 set highlight_paths {}
10853 set findpattern {}
10854 set searchdirn -forwards
10855 set boldids {}
10856 set boldnameids {}
10857 set diffelide {0 0}
10858 set markingmatches 0
10859 set linkentercount 0
10860 set need_redisplay 0
10861 set nrows_drawn 0
10862 set firsttabstop 0
10863
10864 set nextviewnum 1
10865 set curview 0
10866 set selectedview 0
10867 set selectedhlview [mc "None"]
10868 set highlight_related [mc "None"]
10869 set highlight_files {}
10870 set viewfiles(0) {}
10871 set viewperm(0) 0
10872 set viewargs(0) {}
10873 set viewargscmd(0) {}
10874
10875 set selectedline {}
10876 set numcommits 0
10877 set loginstance 0
10878 set cmdlineok 0
10879 set stopped 0
10880 set stuffsaved 0
10881 set patchnum 0
10882 set lserial 0
10883 set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
10884 setcoords
10885 makewindow
10886 # wait for the window to become visible
10887 tkwait visibility .
10888 wm title . "[file tail $argv0]: [file tail [pwd]]"
10889 readrefs
10890
10891 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
10892     # create a view for the files/dirs specified on the command line
10893     set curview 1
10894     set selectedview 1
10895     set nextviewnum 2
10896     set viewname(1) [mc "Command line"]
10897     set viewfiles(1) $cmdline_files
10898     set viewargs(1) $revtreeargs
10899     set viewargscmd(1) $revtreeargscmd
10900     set viewperm(1) 0
10901     set vdatemode(1) 0
10902     addviewmenu 1
10903     .bar.view entryconf [mca "Edit view..."] -state normal
10904     .bar.view entryconf [mca "Delete view"] -state normal
10905 }
10906
10907 if {[info exists permviews]} {
10908     foreach v $permviews {
10909         set n $nextviewnum
10910         incr nextviewnum
10911         set viewname($n) [lindex $v 0]
10912         set viewfiles($n) [lindex $v 1]
10913         set viewargs($n) [lindex $v 2]
10914         set viewargscmd($n) [lindex $v 3]
10915         set viewperm($n) 1
10916         addviewmenu $n
10917     }
10918 }
10919
10920 if {[tk windowingsystem] eq "win32"} {
10921     focus -force .
10922 }
10923
10924 getcommits {}