gitk

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