gitk

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