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} {
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 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         set f [open "~/.gitk-new" w]
2627         if {$::tcl_platform(platform) eq {windows}} {
2628             file attributes "~/.gitk-new" -hidden true
2629         }
2630         puts $f [list set mainfont $mainfont]
2631         puts $f [list set textfont $textfont]
2632         puts $f [list set uifont $uifont]
2633         puts $f [list set tabstop $tabstop]
2634         puts $f [list set findmergefiles $findmergefiles]
2635         puts $f [list set maxgraphpct $maxgraphpct]
2636         puts $f [list set maxwidth $maxwidth]
2637         puts $f [list set cmitmode $cmitmode]
2638         puts $f [list set wrapcomment $wrapcomment]
2639         puts $f [list set autoselect $autoselect]
2640         puts $f [list set showneartags $showneartags]
2641         puts $f [list set hideremotes $hideremotes]
2642         puts $f [list set showlocalchanges $showlocalchanges]
2643         puts $f [list set datetimeformat $datetimeformat]
2644         puts $f [list set limitdiffs $limitdiffs]
2645         puts $f [list set want_ttk $want_ttk]
2646         puts $f [list set bgcolor $bgcolor]
2647         puts $f [list set fgcolor $fgcolor]
2648         puts $f [list set colors $colors]
2649         puts $f [list set diffcolors $diffcolors]
2650         puts $f [list set markbgcolor $markbgcolor]
2651         puts $f [list set diffcontext $diffcontext]
2652         puts $f [list set selectbgcolor $selectbgcolor]
2653         puts $f [list set extdifftool $extdifftool]
2654         puts $f [list set perfile_attrs $perfile_attrs]
2655
2656         puts $f "set geometry(main) [wm geometry .]"
2657         puts $f "set geometry(state) [wm state .]"
2658         puts $f "set geometry(topwidth) [winfo width .tf]"
2659         puts $f "set geometry(topheight) [winfo height .tf]"
2660         if {$use_ttk} {
2661             puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
2662             puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
2663         } else {
2664             puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2665             puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2666         }
2667         puts $f "set geometry(botwidth) [winfo width .bleft]"
2668         puts $f "set geometry(botheight) [winfo height .bleft]"
2669
2670         puts -nonewline $f "set permviews {"
2671         for {set v 0} {$v < $nextviewnum} {incr v} {
2672             if {$viewperm($v)} {
2673                 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
2674             }
2675         }
2676         puts $f "}"
2677         close $f
2678         file rename -force "~/.gitk-new" "~/.gitk"
2679     }
2680     set stuffsaved 1
2681 }
2682
2683 proc resizeclistpanes {win w} {
2684     global oldwidth use_ttk
2685     if {[info exists oldwidth($win)]} {
2686         if {$use_ttk} {
2687             set s0 [$win sashpos 0]
2688             set s1 [$win sashpos 1]
2689         } else {
2690             set s0 [$win sash coord 0]
2691             set s1 [$win sash coord 1]
2692         }
2693         if {$w < 60} {
2694             set sash0 [expr {int($w/2 - 2)}]
2695             set sash1 [expr {int($w*5/6 - 2)}]
2696         } else {
2697             set factor [expr {1.0 * $w / $oldwidth($win)}]
2698             set sash0 [expr {int($factor * [lindex $s0 0])}]
2699             set sash1 [expr {int($factor * [lindex $s1 0])}]
2700             if {$sash0 < 30} {
2701                 set sash0 30
2702             }
2703             if {$sash1 < $sash0 + 20} {
2704                 set sash1 [expr {$sash0 + 20}]
2705             }
2706             if {$sash1 > $w - 10} {
2707                 set sash1 [expr {$w - 10}]
2708                 if {$sash0 > $sash1 - 20} {
2709                     set sash0 [expr {$sash1 - 20}]
2710                 }
2711             }
2712         }
2713         if {$use_ttk} {
2714             $win sashpos 0 $sash0
2715             $win sashpos 1 $sash1
2716         } else {
2717             $win sash place 0 $sash0 [lindex $s0 1]
2718             $win sash place 1 $sash1 [lindex $s1 1]
2719         }
2720     }
2721     set oldwidth($win) $w
2722 }
2723
2724 proc resizecdetpanes {win w} {
2725     global oldwidth use_ttk
2726     if {[info exists oldwidth($win)]} {
2727         if {$use_ttk} {
2728             set s0 [$win sashpos 0]
2729         } else {
2730             set s0 [$win sash coord 0]
2731         }
2732         if {$w < 60} {
2733             set sash0 [expr {int($w*3/4 - 2)}]
2734         } else {
2735             set factor [expr {1.0 * $w / $oldwidth($win)}]
2736             set sash0 [expr {int($factor * [lindex $s0 0])}]
2737             if {$sash0 < 45} {
2738                 set sash0 45
2739             }
2740             if {$sash0 > $w - 15} {
2741                 set sash0 [expr {$w - 15}]
2742             }
2743         }
2744         if {$use_ttk} {
2745             $win sashpos 0 $sash0
2746         } else {
2747             $win sash place 0 $sash0 [lindex $s0 1]
2748         }
2749     }
2750     set oldwidth($win) $w
2751 }
2752
2753 proc allcanvs args {
2754     global canv canv2 canv3
2755     eval $canv $args
2756     eval $canv2 $args
2757     eval $canv3 $args
2758 }
2759
2760 proc bindall {event action} {
2761     global canv canv2 canv3
2762     bind $canv $event $action
2763     bind $canv2 $event $action
2764     bind $canv3 $event $action
2765 }
2766
2767 proc about {} {
2768     global uifont NS
2769     set w .about
2770     if {[winfo exists $w]} {
2771         raise $w
2772         return
2773     }
2774     ttk_toplevel $w
2775     wm title $w [mc "About gitk"]
2776     make_transient $w .
2777     message $w.m -text [mc "
2778 Gitk - a commit viewer for git
2779
2780 Copyright \u00a9 2005-2009 Paul Mackerras
2781
2782 Use and redistribute under the terms of the GNU General Public License"] \
2783             -justify center -aspect 400 -border 2 -bg white -relief groove
2784     pack $w.m -side top -fill x -padx 2 -pady 2
2785     ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2786     pack $w.ok -side bottom
2787     bind $w <Visibility> "focus $w.ok"
2788     bind $w <Key-Escape> "destroy $w"
2789     bind $w <Key-Return> "destroy $w"
2790     tk::PlaceWindow $w widget .
2791 }
2792
2793 proc keys {} {
2794     global NS
2795     set w .keys
2796     if {[winfo exists $w]} {
2797         raise $w
2798         return
2799     }
2800     if {[tk windowingsystem] eq {aqua}} {
2801         set M1T Cmd
2802     } else {
2803         set M1T Ctrl
2804     }
2805     ttk_toplevel $w
2806     wm title $w [mc "Gitk key bindings"]
2807     make_transient $w .
2808     message $w.m -text "
2809 [mc "Gitk key bindings:"]
2810
2811 [mc "<%s-Q>             Quit" $M1T]
2812 [mc "<Home>             Move to first commit"]
2813 [mc "<End>              Move to last commit"]
2814 [mc "<Up>, p, i Move up one commit"]
2815 [mc "<Down>, n, k       Move down one commit"]
2816 [mc "<Left>, z, j       Go back in history list"]
2817 [mc "<Right>, x, l      Go forward in history list"]
2818 [mc "<PageUp>   Move up one page in commit list"]
2819 [mc "<PageDown> Move down one page in commit list"]
2820 [mc "<%s-Home>  Scroll to top of commit list" $M1T]
2821 [mc "<%s-End>   Scroll to bottom of commit list" $M1T]
2822 [mc "<%s-Up>    Scroll commit list up one line" $M1T]
2823 [mc "<%s-Down>  Scroll commit list down one line" $M1T]
2824 [mc "<%s-PageUp>        Scroll commit list up one page" $M1T]
2825 [mc "<%s-PageDown>      Scroll commit list down one page" $M1T]
2826 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
2827 [mc "<Shift-Down>       Find forwards (downwards, earlier commits)"]
2828 [mc "<Delete>, b        Scroll diff view up one page"]
2829 [mc "<Backspace>        Scroll diff view up one page"]
2830 [mc "<Space>            Scroll diff view down one page"]
2831 [mc "u          Scroll diff view up 18 lines"]
2832 [mc "d          Scroll diff view down 18 lines"]
2833 [mc "<%s-F>             Find" $M1T]
2834 [mc "<%s-G>             Move to next find hit" $M1T]
2835 [mc "<Return>   Move to next find hit"]
2836 [mc "/          Focus the search box"]
2837 [mc "?          Move to previous find hit"]
2838 [mc "f          Scroll diff view to next file"]
2839 [mc "<%s-S>             Search for next hit in diff view" $M1T]
2840 [mc "<%s-R>             Search for previous hit in diff view" $M1T]
2841 [mc "<%s-KP+>   Increase font size" $M1T]
2842 [mc "<%s-plus>  Increase font size" $M1T]
2843 [mc "<%s-KP->   Decrease font size" $M1T]
2844 [mc "<%s-minus> Decrease font size" $M1T]
2845 [mc "<F5>               Update"]
2846 " \
2847             -justify left -bg white -border 2 -relief groove
2848     pack $w.m -side top -fill both -padx 2 -pady 2
2849     ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2850     bind $w <Key-Escape> [list destroy $w]
2851     pack $w.ok -side bottom
2852     bind $w <Visibility> "focus $w.ok"
2853     bind $w <Key-Escape> "destroy $w"
2854     bind $w <Key-Return> "destroy $w"
2855 }
2856
2857 # Procedures for manipulating the file list window at the
2858 # bottom right of the overall window.
2859
2860 proc treeview {w l openlevs} {
2861     global treecontents treediropen treeheight treeparent treeindex
2862
2863     set ix 0
2864     set treeindex() 0
2865     set lev 0
2866     set prefix {}
2867     set prefixend -1
2868     set prefendstack {}
2869     set htstack {}
2870     set ht 0
2871     set treecontents() {}
2872     $w conf -state normal
2873     foreach f $l {
2874         while {[string range $f 0 $prefixend] ne $prefix} {
2875             if {$lev <= $openlevs} {
2876                 $w mark set e:$treeindex($prefix) "end -1c"
2877                 $w mark gravity e:$treeindex($prefix) left
2878             }
2879             set treeheight($prefix) $ht
2880             incr ht [lindex $htstack end]
2881             set htstack [lreplace $htstack end end]
2882             set prefixend [lindex $prefendstack end]
2883             set prefendstack [lreplace $prefendstack end end]
2884             set prefix [string range $prefix 0 $prefixend]
2885             incr lev -1
2886         }
2887         set tail [string range $f [expr {$prefixend+1}] end]
2888         while {[set slash [string first "/" $tail]] >= 0} {
2889             lappend htstack $ht
2890             set ht 0
2891             lappend prefendstack $prefixend
2892             incr prefixend [expr {$slash + 1}]
2893             set d [string range $tail 0 $slash]
2894             lappend treecontents($prefix) $d
2895             set oldprefix $prefix
2896             append prefix $d
2897             set treecontents($prefix) {}
2898             set treeindex($prefix) [incr ix]
2899             set treeparent($prefix) $oldprefix
2900             set tail [string range $tail [expr {$slash+1}] end]
2901             if {$lev <= $openlevs} {
2902                 set ht 1
2903                 set treediropen($prefix) [expr {$lev < $openlevs}]
2904                 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
2905                 $w mark set d:$ix "end -1c"
2906                 $w mark gravity d:$ix left
2907                 set str "\n"
2908                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2909                 $w insert end $str
2910                 $w image create end -align center -image $bm -padx 1 \
2911                     -name a:$ix
2912                 $w insert end $d [highlight_tag $prefix]
2913                 $w mark set s:$ix "end -1c"
2914                 $w mark gravity s:$ix left
2915             }
2916             incr lev
2917         }
2918         if {$tail ne {}} {
2919             if {$lev <= $openlevs} {
2920                 incr ht
2921                 set str "\n"
2922                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2923                 $w insert end $str
2924                 $w insert end $tail [highlight_tag $f]
2925             }
2926             lappend treecontents($prefix) $tail
2927         }
2928     }
2929     while {$htstack ne {}} {
2930         set treeheight($prefix) $ht
2931         incr ht [lindex $htstack end]
2932         set htstack [lreplace $htstack end end]
2933         set prefixend [lindex $prefendstack end]
2934         set prefendstack [lreplace $prefendstack end end]
2935         set prefix [string range $prefix 0 $prefixend]
2936     }
2937     $w conf -state disabled
2938 }
2939
2940 proc linetoelt {l} {
2941     global treeheight treecontents
2942
2943     set y 2
2944     set prefix {}
2945     while {1} {
2946         foreach e $treecontents($prefix) {
2947             if {$y == $l} {
2948                 return "$prefix$e"
2949             }
2950             set n 1
2951             if {[string index $e end] eq "/"} {
2952                 set n $treeheight($prefix$e)
2953                 if {$y + $n > $l} {
2954                     append prefix $e
2955                     incr y
2956                     break
2957                 }
2958             }
2959             incr y $n
2960         }
2961     }
2962 }
2963
2964 proc highlight_tree {y prefix} {
2965     global treeheight treecontents cflist
2966
2967     foreach e $treecontents($prefix) {
2968         set path $prefix$e
2969         if {[highlight_tag $path] ne {}} {
2970             $cflist tag add bold $y.0 "$y.0 lineend"
2971         }
2972         incr y
2973         if {[string index $e end] eq "/" && $treeheight($path) > 1} {
2974             set y [highlight_tree $y $path]
2975         }
2976     }
2977     return $y
2978 }
2979
2980 proc treeclosedir {w dir} {
2981     global treediropen treeheight treeparent treeindex
2982
2983     set ix $treeindex($dir)
2984     $w conf -state normal
2985     $w delete s:$ix e:$ix
2986     set treediropen($dir) 0
2987     $w image configure a:$ix -image tri-rt
2988     $w conf -state disabled
2989     set n [expr {1 - $treeheight($dir)}]
2990     while {$dir ne {}} {
2991         incr treeheight($dir) $n
2992         set dir $treeparent($dir)
2993     }
2994 }
2995
2996 proc treeopendir {w dir} {
2997     global treediropen treeheight treeparent treecontents treeindex
2998
2999     set ix $treeindex($dir)
3000     $w conf -state normal
3001     $w image configure a:$ix -image tri-dn
3002     $w mark set e:$ix s:$ix
3003     $w mark gravity e:$ix right
3004     set lev 0
3005     set str "\n"
3006     set n [llength $treecontents($dir)]
3007     for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
3008         incr lev
3009         append str "\t"
3010         incr treeheight($x) $n
3011     }
3012     foreach e $treecontents($dir) {
3013         set de $dir$e
3014         if {[string index $e end] eq "/"} {
3015             set iy $treeindex($de)
3016             $w mark set d:$iy e:$ix
3017             $w mark gravity d:$iy left
3018             $w insert e:$ix $str
3019             set treediropen($de) 0
3020             $w image create e:$ix -align center -image tri-rt -padx 1 \
3021                 -name a:$iy
3022             $w insert e:$ix $e [highlight_tag $de]
3023             $w mark set s:$iy e:$ix
3024             $w mark gravity s:$iy left
3025             set treeheight($de) 1
3026         } else {
3027             $w insert e:$ix $str
3028             $w insert e:$ix $e [highlight_tag $de]
3029         }
3030     }
3031     $w mark gravity e:$ix right
3032     $w conf -state disabled
3033     set treediropen($dir) 1
3034     set top [lindex [split [$w index @0,0] .] 0]
3035     set ht [$w cget -height]
3036     set l [lindex [split [$w index s:$ix] .] 0]
3037     if {$l < $top} {
3038         $w yview $l.0
3039     } elseif {$l + $n + 1 > $top + $ht} {
3040         set top [expr {$l + $n + 2 - $ht}]
3041         if {$l < $top} {
3042             set top $l
3043         }
3044         $w yview $top.0
3045     }
3046 }
3047
3048 proc treeclick {w x y} {
3049     global treediropen cmitmode ctext cflist cflist_top
3050
3051     if {$cmitmode ne "tree"} return
3052     if {![info exists cflist_top]} return
3053     set l [lindex [split [$w index "@$x,$y"] "."] 0]
3054     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3055     $cflist tag add highlight $l.0 "$l.0 lineend"
3056     set cflist_top $l
3057     if {$l == 1} {
3058         $ctext yview 1.0
3059         return
3060     }
3061     set e [linetoelt $l]
3062     if {[string index $e end] ne "/"} {
3063         showfile $e
3064     } elseif {$treediropen($e)} {
3065         treeclosedir $w $e
3066     } else {
3067         treeopendir $w $e
3068     }
3069 }
3070
3071 proc setfilelist {id} {
3072     global treefilelist cflist jump_to_here
3073
3074     treeview $cflist $treefilelist($id) 0
3075     if {$jump_to_here ne {}} {
3076         set f [lindex $jump_to_here 0]
3077         if {[lsearch -exact $treefilelist($id) $f] >= 0} {
3078             showfile $f
3079         }
3080     }
3081 }
3082
3083 image create bitmap tri-rt -background black -foreground blue -data {
3084     #define tri-rt_width 13
3085     #define tri-rt_height 13
3086     static unsigned char tri-rt_bits[] = {
3087        0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
3088        0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
3089        0x00, 0x00};
3090 } -maskdata {
3091     #define tri-rt-mask_width 13
3092     #define tri-rt-mask_height 13
3093     static unsigned char tri-rt-mask_bits[] = {
3094        0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
3095        0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
3096        0x08, 0x00};
3097 }
3098 image create bitmap tri-dn -background black -foreground blue -data {
3099     #define tri-dn_width 13
3100     #define tri-dn_height 13
3101     static unsigned char tri-dn_bits[] = {
3102        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
3103        0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3104        0x00, 0x00};
3105 } -maskdata {
3106     #define tri-dn-mask_width 13
3107     #define tri-dn-mask_height 13
3108     static unsigned char tri-dn-mask_bits[] = {
3109        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
3110        0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
3111        0x00, 0x00};
3112 }
3113
3114 image create bitmap reficon-T -background black -foreground yellow -data {
3115     #define tagicon_width 13
3116     #define tagicon_height 9
3117     static unsigned char tagicon_bits[] = {
3118        0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
3119        0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
3120 } -maskdata {
3121     #define tagicon-mask_width 13
3122     #define tagicon-mask_height 9
3123     static unsigned char tagicon-mask_bits[] = {
3124        0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
3125        0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
3126 }
3127 set rectdata {
3128     #define headicon_width 13
3129     #define headicon_height 9
3130     static unsigned char headicon_bits[] = {
3131        0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3132        0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3133 }
3134 set rectmask {
3135     #define headicon-mask_width 13
3136     #define headicon-mask_height 9
3137     static unsigned char headicon-mask_bits[] = {
3138        0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3139        0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3140 }
3141 image create bitmap reficon-H -background black -foreground green \
3142     -data $rectdata -maskdata $rectmask
3143 image create bitmap reficon-o -background black -foreground "#ddddff" \
3144     -data $rectdata -maskdata $rectmask
3145
3146 proc init_flist {first} {
3147     global cflist cflist_top difffilestart
3148
3149     $cflist conf -state normal
3150     $cflist delete 0.0 end
3151     if {$first ne {}} {
3152         $cflist insert end $first
3153         set cflist_top 1
3154         $cflist tag add highlight 1.0 "1.0 lineend"
3155     } else {
3156         catch {unset cflist_top}
3157     }
3158     $cflist conf -state disabled
3159     set difffilestart {}
3160 }
3161
3162 proc highlight_tag {f} {
3163     global highlight_paths
3164
3165     foreach p $highlight_paths {
3166         if {[string match $p $f]} {
3167             return "bold"
3168         }
3169     }
3170     return {}
3171 }
3172
3173 proc highlight_filelist {} {
3174     global cmitmode cflist
3175
3176     $cflist conf -state normal
3177     if {$cmitmode ne "tree"} {
3178         set end [lindex [split [$cflist index end] .] 0]
3179         for {set l 2} {$l < $end} {incr l} {
3180             set line [$cflist get $l.0 "$l.0 lineend"]
3181             if {[highlight_tag $line] ne {}} {
3182                 $cflist tag add bold $l.0 "$l.0 lineend"
3183             }
3184         }
3185     } else {
3186         highlight_tree 2 {}
3187     }
3188     $cflist conf -state disabled
3189 }
3190
3191 proc unhighlight_filelist {} {
3192     global cflist
3193
3194     $cflist conf -state normal
3195     $cflist tag remove bold 1.0 end
3196     $cflist conf -state disabled
3197 }
3198
3199 proc add_flist {fl} {
3200     global cflist
3201
3202     $cflist conf -state normal
3203     foreach f $fl {
3204         $cflist insert end "\n"
3205         $cflist insert end $f [highlight_tag $f]
3206     }
3207     $cflist conf -state disabled
3208 }
3209
3210 proc sel_flist {w x y} {
3211     global ctext difffilestart cflist cflist_top cmitmode
3212
3213     if {$cmitmode eq "tree"} return
3214     if {![info exists cflist_top]} return
3215     set l [lindex [split [$w index "@$x,$y"] "."] 0]
3216     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3217     $cflist tag add highlight $l.0 "$l.0 lineend"
3218     set cflist_top $l
3219     if {$l == 1} {
3220         $ctext yview 1.0
3221     } else {
3222         catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
3223     }
3224 }
3225
3226 proc pop_flist_menu {w X Y x y} {
3227     global ctext cflist cmitmode flist_menu flist_menu_file
3228     global treediffs diffids
3229
3230     stopfinding
3231     set l [lindex [split [$w index "@$x,$y"] "."] 0]
3232     if {$l <= 1} return
3233     if {$cmitmode eq "tree"} {
3234         set e [linetoelt $l]
3235         if {[string index $e end] eq "/"} return
3236     } else {
3237         set e [lindex $treediffs($diffids) [expr {$l-2}]]
3238     }
3239     set flist_menu_file $e
3240     set xdiffstate "normal"
3241     if {$cmitmode eq "tree"} {
3242         set xdiffstate "disabled"
3243     }
3244     # Disable "External diff" item in tree mode
3245     $flist_menu entryconf 2 -state $xdiffstate
3246     tk_popup $flist_menu $X $Y
3247 }
3248
3249 proc find_ctext_fileinfo {line} {
3250     global ctext_file_names ctext_file_lines
3251
3252     set ok [bsearch $ctext_file_lines $line]
3253     set tline [lindex $ctext_file_lines $ok]
3254
3255     if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3256         return {}
3257     } else {
3258         return [list [lindex $ctext_file_names $ok] $tline]
3259     }
3260 }
3261
3262 proc pop_diff_menu {w X Y x y} {
3263     global ctext diff_menu flist_menu_file
3264     global diff_menu_txtpos diff_menu_line
3265     global diff_menu_filebase
3266
3267     set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3268     set diff_menu_line [lindex $diff_menu_txtpos 0]
3269     # don't pop up the menu on hunk-separator or file-separator lines
3270     if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3271         return
3272     }
3273     stopfinding
3274     set f [find_ctext_fileinfo $diff_menu_line]
3275     if {$f eq {}} return
3276     set flist_menu_file [lindex $f 0]
3277     set diff_menu_filebase [lindex $f 1]
3278     tk_popup $diff_menu $X $Y
3279 }
3280
3281 proc flist_hl {only} {
3282     global flist_menu_file findstring gdttype
3283
3284     set x [shellquote $flist_menu_file]
3285     if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
3286         set findstring $x
3287     } else {
3288         append findstring " " $x
3289     }
3290     set gdttype [mc "touching paths:"]
3291 }
3292
3293 proc gitknewtmpdir {} {
3294     global diffnum gitktmpdir gitdir
3295
3296     if {![info exists gitktmpdir]} {
3297         set gitktmpdir [file join [file dirname $gitdir] \
3298                             [format ".gitk-tmp.%s" [pid]]]
3299         if {[catch {file mkdir $gitktmpdir} err]} {
3300             error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3301             unset gitktmpdir
3302             return {}
3303         }
3304         set diffnum 0
3305     }
3306     incr diffnum
3307     set diffdir [file join $gitktmpdir $diffnum]
3308     if {[catch {file mkdir $diffdir} err]} {
3309         error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3310         return {}
3311     }
3312     return $diffdir
3313 }
3314
3315 proc save_file_from_commit {filename output what} {
3316     global nullfile
3317
3318     if {[catch {exec git show $filename -- > $output} err]} {
3319         if {[string match "fatal: bad revision *" $err]} {
3320             return $nullfile
3321         }
3322         error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
3323         return {}
3324     }
3325     return $output
3326 }
3327
3328 proc external_diff_get_one_file {diffid filename diffdir} {
3329     global nullid nullid2 nullfile
3330     global gitdir
3331
3332     if {$diffid == $nullid} {
3333         set difffile [file join [file dirname $gitdir] $filename]
3334         if {[file exists $difffile]} {
3335             return $difffile
3336         }
3337         return $nullfile
3338     }
3339     if {$diffid == $nullid2} {
3340         set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3341         return [save_file_from_commit :$filename $difffile index]
3342     }
3343     set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3344     return [save_file_from_commit $diffid:$filename $difffile \
3345                "revision $diffid"]
3346 }
3347
3348 proc external_diff {} {
3349     global nullid nullid2
3350     global flist_menu_file
3351     global diffids
3352     global extdifftool
3353
3354     if {[llength $diffids] == 1} {
3355         # no reference commit given
3356         set diffidto [lindex $diffids 0]
3357         if {$diffidto eq $nullid} {
3358             # diffing working copy with index
3359             set diffidfrom $nullid2
3360         } elseif {$diffidto eq $nullid2} {
3361             # diffing index with HEAD
3362             set diffidfrom "HEAD"
3363         } else {
3364             # use first parent commit
3365             global parentlist selectedline
3366             set diffidfrom [lindex $parentlist $selectedline 0]
3367         }
3368     } else {
3369         set diffidfrom [lindex $diffids 0]
3370         set diffidto [lindex $diffids 1]
3371     }
3372
3373     # make sure that several diffs wont collide
3374     set diffdir [gitknewtmpdir]
3375     if {$diffdir eq {}} return
3376
3377     # gather files to diff
3378     set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3379     set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3380
3381     if {$difffromfile ne {} && $difftofile ne {}} {
3382         set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
3383         if {[catch {set fl [open |$cmd r]} err]} {
3384             file delete -force $diffdir
3385             error_popup "$extdifftool: [mc "command failed:"] $err"
3386         } else {
3387             fconfigure $fl -blocking 0
3388             filerun $fl [list delete_at_eof $fl $diffdir]
3389         }
3390     }
3391 }
3392
3393 proc find_hunk_blamespec {base line} {
3394     global ctext
3395
3396     # Find and parse the hunk header
3397     set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3398     if {$s_lix eq {}} return
3399
3400     set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3401     if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3402             s_line old_specs osz osz1 new_line nsz]} {
3403         return
3404     }
3405
3406     # base lines for the parents
3407     set base_lines [list $new_line]
3408     foreach old_spec [lrange [split $old_specs " "] 1 end] {
3409         if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3410                 old_spec old_line osz]} {
3411             return
3412         }
3413         lappend base_lines $old_line
3414     }
3415
3416     # Now scan the lines to determine offset within the hunk
3417     set max_parent [expr {[llength $base_lines]-2}]
3418     set dline 0
3419     set s_lno [lindex [split $s_lix "."] 0]
3420
3421     # Determine if the line is removed
3422     set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3423     if {[string match {[-+ ]*} $chunk]} {
3424         set removed_idx [string first "-" $chunk]
3425         # Choose a parent index
3426         if {$removed_idx >= 0} {
3427             set parent $removed_idx
3428         } else {
3429             set unchanged_idx [string first " " $chunk]
3430             if {$unchanged_idx >= 0} {
3431                 set parent $unchanged_idx
3432             } else {
3433                 # blame the current commit
3434                 set parent -1
3435             }
3436         }
3437         # then count other lines that belong to it
3438         for {set i $line} {[incr i -1] > $s_lno} {} {
3439             set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3440             # Determine if the line is removed
3441             set removed_idx [string first "-" $chunk]
3442             if {$parent >= 0} {
3443                 set code [string index $chunk $parent]
3444                 if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3445                     incr dline
3446                 }
3447             } else {
3448                 if {$removed_idx < 0} {
3449                     incr dline
3450                 }
3451             }
3452         }
3453         incr parent
3454     } else {
3455         set parent 0
3456     }
3457
3458     incr dline [lindex $base_lines $parent]
3459     return [list $parent $dline]
3460 }
3461
3462 proc external_blame_diff {} {
3463     global currentid cmitmode
3464     global diff_menu_txtpos diff_menu_line
3465     global diff_menu_filebase flist_menu_file
3466
3467     if {$cmitmode eq "tree"} {
3468         set parent_idx 0
3469         set line [expr {$diff_menu_line - $diff_menu_filebase}]
3470     } else {
3471         set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3472         if {$hinfo ne {}} {
3473             set parent_idx [lindex $hinfo 0]
3474             set line [lindex $hinfo 1]
3475         } else {
3476             set parent_idx 0
3477             set line 0
3478         }
3479     }
3480
3481     external_blame $parent_idx $line
3482 }
3483
3484 # Find the SHA1 ID of the blob for file $fname in the index
3485 # at stage 0 or 2
3486 proc index_sha1 {fname} {
3487     set f [open [list | git ls-files -s $fname] r]
3488     while {[gets $f line] >= 0} {
3489         set info [lindex [split $line "\t"] 0]
3490         set stage [lindex $info 2]
3491         if {$stage eq "0" || $stage eq "2"} {
3492             close $f
3493             return [lindex $info 1]
3494         }
3495     }
3496     close $f
3497     return {}
3498 }
3499
3500 # Turn an absolute path into one relative to the current directory
3501 proc make_relative {f} {
3502     set elts [file split $f]
3503     set here [file split [pwd]]
3504     set ei 0
3505     set hi 0
3506     set res {}
3507     foreach d $here {
3508         if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3509             lappend res ".."
3510         } else {
3511             incr ei
3512         }
3513         incr hi
3514     }
3515     set elts [concat $res [lrange $elts $ei end]]
3516     return [eval file join $elts]
3517 }
3518
3519 proc external_blame {parent_idx {line {}}} {
3520     global flist_menu_file gitdir
3521     global nullid nullid2
3522     global parentlist selectedline currentid
3523
3524     if {$parent_idx > 0} {
3525         set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3526     } else {
3527         set base_commit $currentid
3528     }
3529
3530     if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3531         error_popup [mc "No such commit"]
3532         return
3533     }
3534
3535     set cmdline [list git gui blame]
3536     if {$line ne {} && $line > 1} {
3537         lappend cmdline "--line=$line"
3538     }
3539     set f [file join [file dirname $gitdir] $flist_menu_file]
3540     # Unfortunately it seems git gui blame doesn't like
3541     # being given an absolute path...
3542     set f [make_relative $f]
3543     lappend cmdline $base_commit $f
3544     if {[catch {eval exec $cmdline &} err]} {
3545         error_popup "[mc "git gui blame: command failed:"] $err"
3546     }
3547 }
3548
3549 proc show_line_source {} {
3550     global cmitmode currentid parents curview blamestuff blameinst
3551     global diff_menu_line diff_menu_filebase flist_menu_file
3552     global nullid nullid2 gitdir
3553
3554     set from_index {}
3555     if {$cmitmode eq "tree"} {
3556         set id $currentid
3557         set line [expr {$diff_menu_line - $diff_menu_filebase}]
3558     } else {
3559         set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3560         if {$h eq {}} return
3561         set pi [lindex $h 0]
3562         if {$pi == 0} {
3563             mark_ctext_line $diff_menu_line
3564             return
3565         }
3566         incr pi -1
3567         if {$currentid eq $nullid} {
3568             if {$pi > 0} {
3569                 # must be a merge in progress...
3570                 if {[catch {
3571                     # get the last line from .git/MERGE_HEAD
3572                     set f [open [file join $gitdir MERGE_HEAD] r]
3573                     set id [lindex [split [read $f] "\n"] end-1]
3574                     close $f
3575                 } err]} {
3576                     error_popup [mc "Couldn't read merge head: %s" $err]
3577                     return
3578                 }
3579             } elseif {$parents($curview,$currentid) eq $nullid2} {
3580                 # need to do the blame from the index
3581                 if {[catch {
3582                     set from_index [index_sha1 $flist_menu_file]
3583                 } err]} {
3584                     error_popup [mc "Error reading index: %s" $err]
3585                     return
3586                 }
3587             } else {
3588                 set id $parents($curview,$currentid)
3589             }
3590         } else {
3591             set id [lindex $parents($curview,$currentid) $pi]
3592         }
3593         set line [lindex $h 1]
3594     }
3595     set blameargs {}
3596     if {$from_index ne {}} {
3597         lappend blameargs | git cat-file blob $from_index
3598     }
3599     lappend blameargs | git blame -p -L$line,+1
3600     if {$from_index ne {}} {
3601         lappend blameargs --contents -
3602     } else {
3603         lappend blameargs $id
3604     }
3605     lappend blameargs -- [file join [file dirname $gitdir] $flist_menu_file]
3606     if {[catch {
3607         set f [open $blameargs r]
3608     } err]} {
3609         error_popup [mc "Couldn't start git blame: %s" $err]
3610         return
3611     }
3612     nowbusy blaming [mc "Searching"]
3613     fconfigure $f -blocking 0
3614     set i [reg_instance $f]
3615     set blamestuff($i) {}
3616     set blameinst $i
3617     filerun $f [list read_line_source $f $i]
3618 }
3619
3620 proc stopblaming {} {
3621     global blameinst
3622
3623     if {[info exists blameinst]} {
3624         stop_instance $blameinst
3625         unset blameinst
3626         notbusy blaming
3627     }
3628 }
3629
3630 proc read_line_source {fd inst} {
3631     global blamestuff curview commfd blameinst nullid nullid2
3632
3633     while {[gets $fd line] >= 0} {
3634         lappend blamestuff($inst) $line
3635     }
3636     if {![eof $fd]} {
3637         return 1
3638     }
3639     unset commfd($inst)
3640     unset blameinst
3641     notbusy blaming
3642     fconfigure $fd -blocking 1
3643     if {[catch {close $fd} err]} {
3644         error_popup [mc "Error running git blame: %s" $err]
3645         return 0
3646     }
3647
3648     set fname {}
3649     set line [split [lindex $blamestuff($inst) 0] " "]
3650     set id [lindex $line 0]
3651     set lnum [lindex $line 1]
3652     if {[string length $id] == 40 && [string is xdigit $id] &&
3653         [string is digit -strict $lnum]} {
3654         # look for "filename" line
3655         foreach l $blamestuff($inst) {
3656             if {[string match "filename *" $l]} {
3657                 set fname [string range $l 9 end]
3658                 break
3659             }
3660         }
3661     }
3662     if {$fname ne {}} {
3663         # all looks good, select it
3664         if {$id eq $nullid} {
3665             # blame uses all-zeroes to mean not committed,
3666             # which would mean a change in the index
3667             set id $nullid2
3668         }
3669         if {[commitinview $id $curview]} {
3670             selectline [rowofcommit $id] 1 [list $fname $lnum]
3671         } else {
3672             error_popup [mc "That line comes from commit %s, \
3673                              which is not in this view" [shortids $id]]
3674         }
3675     } else {
3676         puts "oops couldn't parse git blame output"
3677     }
3678     return 0
3679 }
3680
3681 # delete $dir when we see eof on $f (presumably because the child has exited)
3682 proc delete_at_eof {f dir} {
3683     while {[gets $f line] >= 0} {}
3684     if {[eof $f]} {
3685         if {[catch {close $f} err]} {
3686             error_popup "[mc "External diff viewer failed:"] $err"
3687         }
3688         file delete -force $dir
3689         return 0
3690     }
3691     return 1
3692 }
3693
3694 # Functions for adding and removing shell-type quoting
3695
3696 proc shellquote {str} {
3697     if {![string match "*\['\"\\ \t]*" $str]} {
3698         return $str
3699     }
3700     if {![string match "*\['\"\\]*" $str]} {
3701         return "\"$str\""
3702     }
3703     if {![string match "*'*" $str]} {
3704         return "'$str'"
3705     }
3706     return "\"[string map {\" \\\" \\ \\\\} $str]\""
3707 }
3708
3709 proc shellarglist {l} {
3710     set str {}
3711     foreach a $l {
3712         if {$str ne {}} {
3713             append str " "
3714         }
3715         append str [shellquote $a]
3716     }
3717     return $str
3718 }
3719
3720 proc shelldequote {str} {
3721     set ret {}
3722     set used -1
3723     while {1} {
3724         incr used
3725         if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
3726             append ret [string range $str $used end]
3727             set used [string length $str]
3728             break
3729         }
3730         set first [lindex $first 0]
3731         set ch [string index $str $first]
3732         if {$first > $used} {
3733             append ret [string range $str $used [expr {$first - 1}]]
3734             set used $first
3735         }
3736         if {$ch eq " " || $ch eq "\t"} break
3737         incr used
3738         if {$ch eq "'"} {
3739             set first [string first "'" $str $used]
3740             if {$first < 0} {
3741                 error "unmatched single-quote"
3742             }
3743             append ret [string range $str $used [expr {$first - 1}]]
3744             set used $first
3745             continue
3746         }
3747         if {$ch eq "\\"} {
3748             if {$used >= [string length $str]} {
3749                 error "trailing backslash"
3750             }
3751             append ret [string index $str $used]
3752             continue
3753         }
3754         # here ch == "\""
3755         while {1} {
3756             if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
3757                 error "unmatched double-quote"
3758             }
3759             set first [lindex $first 0]
3760             set ch [string index $str $first]
3761             if {$first > $used} {
3762                 append ret [string range $str $used [expr {$first - 1}]]
3763                 set used $first
3764             }
3765             if {$ch eq "\""} break
3766             incr used
3767             append ret [string index $str $used]
3768             incr used
3769         }
3770     }
3771     return [list $used $ret]
3772 }
3773
3774 proc shellsplit {str} {
3775     set l {}
3776     while {1} {
3777         set str [string trimleft $str]
3778         if {$str eq {}} break
3779         set dq [shelldequote $str]
3780         set n [lindex $dq 0]
3781         set word [lindex $dq 1]
3782         set str [string range $str $n end]
3783         lappend l $word
3784     }
3785     return $l
3786 }
3787
3788 # Code to implement multiple views
3789
3790 proc newview {ishighlight} {
3791     global nextviewnum newviewname newishighlight
3792     global revtreeargs viewargscmd newviewopts curview
3793
3794     set newishighlight $ishighlight
3795     set top .gitkview
3796     if {[winfo exists $top]} {
3797         raise $top
3798         return
3799     }
3800     set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
3801     set newviewopts($nextviewnum,perm) 0
3802     set newviewopts($nextviewnum,cmd)  $viewargscmd($curview)
3803     decode_view_opts $nextviewnum $revtreeargs
3804     vieweditor $top $nextviewnum [mc "Gitk view definition"]
3805 }
3806
3807 set known_view_options {
3808     {perm      b    .  {}               {mc "Remember this view"}}
3809     {reflabel  l    +  {}               {mc "References (space separated list):"}}
3810     {refs      t15  .. {}               {mc "Branches & tags:"}}
3811     {allrefs   b    *. "--all"          {mc "All refs"}}
3812     {branches  b    .  "--branches"     {mc "All (local) branches"}}
3813     {tags      b    .  "--tags"         {mc "All tags"}}
3814     {remotes   b    .  "--remotes"      {mc "All remote-tracking branches"}}
3815     {commitlbl l    +  {}               {mc "Commit Info (regular expressions):"}}
3816     {author    t15  .. "--author=*"     {mc "Author:"}}
3817     {committer t15  .  "--committer=*"  {mc "Committer:"}}
3818     {loginfo   t15  .. "--grep=*"       {mc "Commit Message:"}}
3819     {allmatch  b    .. "--all-match"    {mc "Matches all Commit Info criteria"}}
3820     {changes_l l    +  {}               {mc "Changes to Files:"}}
3821     {pickaxe_s r0   .  {}               {mc "Fixed String"}}
3822     {pickaxe_t r1   .  "--pickaxe-regex"  {mc "Regular Expression"}}
3823     {pickaxe   t15  .. "-S*"            {mc "Search string:"}}
3824     {datelabel l    +  {}               {mc "Commit Dates (\"2 weeks ago\", \"2009-03-17 15:27:38\", \"March 17, 2009 15:27:38\"):"}}
3825     {since     t15  ..  {"--since=*" "--after=*"}  {mc "Since:"}}
3826     {until     t15  .   {"--until=*" "--before=*"} {mc "Until:"}}
3827     {limit_lbl l    +  {}               {mc "Limit and/or skip a number of revisions (positive integer):"}}
3828     {limit     t10  *. "--max-count=*"  {mc "Number to show:"}}
3829     {skip      t10  .  "--skip=*"       {mc "Number to skip:"}}
3830     {misc_lbl  l    +  {}               {mc "Miscellaneous options:"}}
3831     {dorder    b    *. {"--date-order" "-d"}      {mc "Strictly sort by date"}}
3832     {lright    b    .  "--left-right"   {mc "Mark branch sides"}}
3833     {first     b    .  "--first-parent" {mc "Limit to first parent"}}
3834     {smplhst   b    .  "--simplify-by-decoration"   {mc "Simple history"}}
3835     {args      t50  *. {}               {mc "Additional arguments to git log:"}}
3836     {allpaths  path +  {}               {mc "Enter files and directories to include, one per line:"}}
3837     {cmd       t50= +  {}               {mc "Command to generate more commits to include:"}}
3838     }
3839
3840 proc encode_view_opts {n} {
3841     global known_view_options newviewopts
3842
3843     set rargs [list]
3844     foreach opt $known_view_options {
3845         set patterns [lindex $opt 3]
3846         if {$patterns eq {}} continue
3847         set pattern [lindex $patterns 0]
3848
3849         if {[lindex $opt 1] eq "b"} {
3850             set val $newviewopts($n,[lindex $opt 0])
3851             if {$val} {
3852                 lappend rargs $pattern
3853             }
3854         } elseif {[regexp {^r(\d+)$} [lindex $opt 1] type value]} {
3855             regexp {^(.*_)} [lindex $opt 0] uselessvar button_id
3856             set val $newviewopts($n,$button_id)
3857             if {$val eq $value} {
3858                 lappend rargs $pattern
3859             }
3860         } else {
3861             set val $newviewopts($n,[lindex $opt 0])
3862             set val [string trim $val]
3863             if {$val ne {}} {
3864                 set pfix [string range $pattern 0 end-1]
3865                 lappend rargs $pfix$val
3866             }
3867         }
3868     }
3869     set rargs [concat $rargs [shellsplit $newviewopts($n,refs)]]
3870     return [concat $rargs [shellsplit $newviewopts($n,args)]]
3871 }
3872
3873 proc decode_view_opts {n view_args} {
3874     global known_view_options newviewopts
3875
3876     foreach opt $known_view_options {
3877         set id [lindex $opt 0]
3878         if {[lindex $opt 1] eq "b"} {
3879             # Checkboxes
3880             set val 0
3881         } elseif {[regexp {^r(\d+)$} [lindex $opt 1]]} {
3882             # Radiobuttons
3883             regexp {^(.*_)} $id uselessvar id
3884             set val 0
3885         } else {
3886             # Text fields
3887             set val {}
3888         }
3889         set newviewopts($n,$id) $val
3890     }
3891     set oargs [list]
3892     set refargs [list]
3893     foreach arg $view_args {
3894         if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
3895             && ![info exists found(limit)]} {
3896             set newviewopts($n,limit) $cnt
3897             set found(limit) 1
3898             continue
3899         }
3900         catch { unset val }
3901         foreach opt $known_view_options {
3902             set id [lindex $opt 0]
3903             if {[info exists found($id)]} continue
3904             foreach pattern [lindex $opt 3] {
3905                 if {![string match $pattern $arg]} continue
3906                 if {[lindex $opt 1] eq "b"} {
3907                     # Check buttons
3908                     set val 1
3909                 } elseif {[regexp {^r(\d+)$} [lindex $opt 1] match num]} {
3910                     # Radio buttons
3911                     regexp {^(.*_)} $id uselessvar id
3912                     set val $num
3913                 } else {
3914                     # Text input fields
3915                     set size [string length $pattern]
3916                     set val [string range $arg [expr {$size-1}] end]
3917                 }
3918                 set newviewopts($n,$id) $val
3919                 set found($id) 1
3920                 break
3921             }
3922             if {[info exists val]} break
3923         }
3924         if {[info exists val]} continue
3925         if {[regexp {^-} $arg]} {
3926             lappend oargs $arg
3927         } else {
3928             lappend refargs $arg
3929         }
3930     }
3931     set newviewopts($n,refs) [shellarglist $refargs]
3932     set newviewopts($n,args) [shellarglist $oargs]
3933 }
3934
3935 proc edit_or_newview {} {
3936     global curview
3937
3938     if {$curview > 0} {
3939         editview
3940     } else {
3941         newview 0
3942     }
3943 }
3944
3945 proc editview {} {
3946     global curview
3947     global viewname viewperm newviewname newviewopts
3948     global viewargs viewargscmd
3949
3950     set top .gitkvedit-$curview
3951     if {[winfo exists $top]} {
3952         raise $top
3953         return
3954     }
3955     set newviewname($curview)      $viewname($curview)
3956     set newviewopts($curview,perm) $viewperm($curview)
3957     set newviewopts($curview,cmd)  $viewargscmd($curview)
3958     decode_view_opts $curview $viewargs($curview)
3959     vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
3960 }
3961
3962 proc vieweditor {top n title} {
3963     global newviewname newviewopts viewfiles bgcolor
3964     global known_view_options NS
3965
3966     ttk_toplevel $top
3967     wm title $top [concat $title [mc "-- criteria for selecting revisions"]]
3968     make_transient $top .
3969
3970     # View name
3971     ${NS}::frame $top.nfr
3972     ${NS}::label $top.nl -text [mc "View Name"]
3973     ${NS}::entry $top.name -width 20 -textvariable newviewname($n)
3974     pack $top.nfr -in $top -fill x -pady 5 -padx 3
3975     pack $top.nl -in $top.nfr -side left -padx {0 5}
3976     pack $top.name -in $top.nfr -side left -padx {0 25}
3977
3978     # View options
3979     set cframe $top.nfr
3980     set cexpand 0
3981     set cnt 0
3982     foreach opt $known_view_options {
3983         set id [lindex $opt 0]
3984         set type [lindex $opt 1]
3985         set flags [lindex $opt 2]
3986         set title [eval [lindex $opt 4]]
3987         set lxpad 0
3988
3989         if {$flags eq "+" || $flags eq "*"} {
3990             set cframe $top.fr$cnt
3991             incr cnt
3992             ${NS}::frame $cframe
3993             pack $cframe -in $top -fill x -pady 3 -padx 3
3994             set cexpand [expr {$flags eq "*"}]
3995         } elseif {$flags eq ".." || $flags eq "*."} {
3996             set cframe $top.fr$cnt
3997             incr cnt
3998             ${NS}::frame $cframe
3999             pack $cframe -in $top -fill x -pady 3 -padx [list 15 3]
4000             set cexpand [expr {$flags eq "*."}]
4001         } else {
4002             set lxpad 5
4003         }
4004
4005         if {$type eq "l"} {
4006             ${NS}::label $cframe.l_$id -text $title
4007             pack $cframe.l_$id -in $cframe -side left -pady [list 3 0] -anchor w
4008         } elseif {$type eq "b"} {
4009             ${NS}::checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
4010             pack $cframe.c_$id -in $cframe -side left \
4011                 -padx [list $lxpad 0] -expand $cexpand -anchor w
4012         } elseif {[regexp {^r(\d+)$} $type type sz]} {
4013             regexp {^(.*_)} $id uselessvar button_id
4014             ${NS}::radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz
4015             pack $cframe.c_$id -in $cframe -side left \
4016                 -padx [list $lxpad 0] -expand $cexpand -anchor w
4017         } elseif {[regexp {^t(\d+)$} $type type sz]} {
4018             ${NS}::label $cframe.l_$id -text $title
4019             ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4020                 -textvariable newviewopts($n,$id)
4021             pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
4022             pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
4023         } elseif {[regexp {^t(\d+)=$} $type type sz]} {
4024             ${NS}::label $cframe.l_$id -text $title
4025             ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4026                 -textvariable newviewopts($n,$id)
4027             pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
4028             pack $cframe.e_$id -in $cframe -side top -fill x
4029         } elseif {$type eq "path"} {
4030             ${NS}::label $top.l -text $title
4031             pack $top.l -in $top -side top -pady [list 3 0] -anchor w -padx 3
4032             text $top.t -width 40 -height 5 -background $bgcolor -font uifont
4033             if {[info exists viewfiles($n)]} {
4034                 foreach f $viewfiles($n) {
4035                     $top.t insert end $f
4036                     $top.t insert end "\n"
4037                 }
4038                 $top.t delete {end - 1c} end
4039                 $top.t mark set insert 0.0
4040             }
4041             pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
4042         }
4043     }
4044
4045     ${NS}::frame $top.buts
4046     ${NS}::button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
4047     ${NS}::button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
4048     ${NS}::button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
4049     bind $top <Control-Return> [list newviewok $top $n]
4050     bind $top <F5> [list newviewok $top $n 1]
4051     bind $top <Escape> [list destroy $top]
4052     grid $top.buts.ok $top.buts.apply $top.buts.can
4053     grid columnconfigure $top.buts 0 -weight 1 -uniform a
4054     grid columnconfigure $top.buts 1 -weight 1 -uniform a
4055     grid columnconfigure $top.buts 2 -weight 1 -uniform a
4056     pack $top.buts -in $top -side top -fill x
4057     focus $top.t
4058 }
4059
4060 proc doviewmenu {m first cmd op argv} {
4061     set nmenu [$m index end]
4062     for {set i $first} {$i <= $nmenu} {incr i} {
4063         if {[$m entrycget $i -command] eq $cmd} {
4064             eval $m $op $i $argv
4065             break
4066         }
4067     }
4068 }
4069
4070 proc allviewmenus {n op args} {
4071     # global viewhlmenu
4072
4073     doviewmenu .bar.view 5 [list showview $n] $op $args
4074     # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
4075 }
4076
4077 proc newviewok {top n {apply 0}} {
4078     global nextviewnum newviewperm newviewname newishighlight
4079     global viewname viewfiles viewperm selectedview curview
4080     global viewargs viewargscmd newviewopts viewhlmenu
4081
4082     if {[catch {
4083         set newargs [encode_view_opts $n]
4084     } err]} {
4085         error_popup "[mc "Error in commit selection arguments:"] $err" $top
4086         return
4087     }
4088     set files {}
4089     foreach f [split [$top.t get 0.0 end] "\n"] {
4090         set ft [string trim $f]
4091         if {$ft ne {}} {
4092             lappend files $ft
4093         }
4094     }
4095     if {![info exists viewfiles($n)]} {
4096         # creating a new view
4097         incr nextviewnum
4098         set viewname($n) $newviewname($n)
4099         set viewperm($n) $newviewopts($n,perm)
4100         set viewfiles($n) $files
4101         set viewargs($n) $newargs
4102         set viewargscmd($n) $newviewopts($n,cmd)
4103         addviewmenu $n
4104         if {!$newishighlight} {
4105             run showview $n
4106         } else {
4107             run addvhighlight $n
4108         }
4109     } else {
4110         # editing an existing view
4111         set viewperm($n) $newviewopts($n,perm)
4112         if {$newviewname($n) ne $viewname($n)} {
4113             set viewname($n) $newviewname($n)
4114             doviewmenu .bar.view 5 [list showview $n] \
4115                 entryconf [list -label $viewname($n)]
4116             # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
4117                 # entryconf [list -label $viewname($n) -value $viewname($n)]
4118         }
4119         if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
4120                 $newviewopts($n,cmd) ne $viewargscmd($n)} {
4121             set viewfiles($n) $files
4122             set viewargs($n) $newargs
4123             set viewargscmd($n) $newviewopts($n,cmd)
4124             if {$curview == $n} {
4125                 run reloadcommits
4126             }
4127         }
4128     }
4129     if {$apply} return
4130     catch {destroy $top}
4131 }
4132
4133 proc delview {} {
4134     global curview viewperm hlview selectedhlview
4135
4136     if {$curview == 0} return
4137     if {[info exists hlview] && $hlview == $curview} {
4138         set selectedhlview [mc "None"]
4139         unset hlview
4140     }
4141     allviewmenus $curview delete
4142     set viewperm($curview) 0
4143     showview 0
4144 }
4145
4146 proc addviewmenu {n} {
4147     global viewname viewhlmenu
4148
4149     .bar.view add radiobutton -label $viewname($n) \
4150         -command [list showview $n] -variable selectedview -value $n
4151     #$viewhlmenu add radiobutton -label $viewname($n) \
4152     #   -command [list addvhighlight $n] -variable selectedhlview
4153 }
4154
4155 proc showview {n} {
4156     global curview cached_commitrow ordertok
4157     global displayorder parentlist rowidlist rowisopt rowfinal
4158     global colormap rowtextx nextcolor canvxmax
4159     global numcommits viewcomplete
4160     global selectedline currentid canv canvy0
4161     global treediffs
4162     global pending_select mainheadid
4163     global commitidx
4164     global selectedview
4165     global hlview selectedhlview commitinterest
4166
4167     if {$n == $curview} return
4168     set selid {}
4169     set ymax [lindex [$canv cget -scrollregion] 3]
4170     set span [$canv yview]
4171     set ytop [expr {[lindex $span 0] * $ymax}]
4172     set ybot [expr {[lindex $span 1] * $ymax}]
4173     set yscreen [expr {($ybot - $ytop) / 2}]
4174     if {$selectedline ne {}} {
4175         set selid $currentid
4176         set y [yc $selectedline]
4177         if {$ytop < $y && $y < $ybot} {
4178             set yscreen [expr {$y - $ytop}]
4179         }
4180     } elseif {[info exists pending_select]} {
4181         set selid $pending_select
4182         unset pending_select
4183     }
4184     unselectline
4185     normalline
4186     catch {unset treediffs}
4187     clear_display
4188     if {[info exists hlview] && $hlview == $n} {
4189         unset hlview
4190         set selectedhlview [mc "None"]
4191     }
4192     catch {unset commitinterest}
4193     catch {unset cached_commitrow}
4194     catch {unset ordertok}
4195
4196     set curview $n
4197     set selectedview $n
4198     .bar.view entryconf [mca "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
4199     .bar.view entryconf [mca "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
4200
4201     run refill_reflist
4202     if {![info exists viewcomplete($n)]} {
4203         getcommits $selid
4204         return
4205     }
4206
4207     set displayorder {}
4208     set parentlist {}
4209     set rowidlist {}
4210     set rowisopt {}
4211     set rowfinal {}
4212     set numcommits $commitidx($n)
4213
4214     catch {unset colormap}
4215     catch {unset rowtextx}
4216     set nextcolor 0
4217     set canvxmax [$canv cget -width]
4218     set curview $n
4219     set row 0
4220     setcanvscroll
4221     set yf 0
4222     set row {}
4223     if {$selid ne {} && [commitinview $selid $n]} {
4224         set row [rowofcommit $selid]
4225         # try to get the selected row in the same position on the screen
4226         set ymax [lindex [$canv cget -scrollregion] 3]
4227         set ytop [expr {[yc $row] - $yscreen}]
4228         if {$ytop < 0} {
4229             set ytop 0
4230         }
4231         set yf [expr {$ytop * 1.0 / $ymax}]
4232     }
4233     allcanvs yview moveto $yf
4234     drawvisible
4235     if {$row ne {}} {
4236         selectline $row 0
4237     } elseif {!$viewcomplete($n)} {
4238         reset_pending_select $selid
4239     } else {
4240         reset_pending_select {}
4241
4242         if {[commitinview $pending_select $curview]} {
4243             selectline [rowofcommit $pending_select] 1
4244         } else {
4245             set row [first_real_row]
4246             if {$row < $numcommits} {
4247                 selectline $row 0
4248             }
4249         }
4250     }
4251     if {!$viewcomplete($n)} {
4252         if {$numcommits == 0} {
4253             show_status [mc "Reading commits..."]
4254         }
4255     } elseif {$numcommits == 0} {
4256         show_status [mc "No commits selected"]
4257     }
4258 }
4259
4260 # Stuff relating to the highlighting facility
4261
4262 proc ishighlighted {id} {
4263     global vhighlights fhighlights nhighlights rhighlights
4264
4265     if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
4266         return $nhighlights($id)
4267     }
4268     if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
4269         return $vhighlights($id)
4270     }
4271     if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
4272         return $fhighlights($id)
4273     }
4274     if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4275         return $rhighlights($id)
4276     }
4277     return 0
4278 }
4279
4280 proc bolden {id font} {
4281     global canv linehtag currentid boldids need_redisplay markedid
4282
4283     # need_redisplay = 1 means the display is stale and about to be redrawn
4284     if {$need_redisplay} return
4285     lappend boldids $id
4286     $canv itemconf $linehtag($id) -font $font
4287     if {[info exists currentid] && $id eq $currentid} {
4288         $canv delete secsel
4289         set t [eval $canv create rect [$canv bbox $linehtag($id)] \
4290                    -outline {{}} -tags secsel \
4291                    -fill [$canv cget -selectbackground]]
4292         $canv lower $t
4293     }
4294     if {[info exists markedid] && $id eq $markedid} {
4295         make_idmark $id
4296     }
4297 }
4298
4299 proc bolden_name {id font} {
4300     global canv2 linentag currentid boldnameids need_redisplay
4301
4302     if {$need_redisplay} return
4303     lappend boldnameids $id
4304     $canv2 itemconf $linentag($id) -font $font
4305     if {[info exists currentid] && $id eq $currentid} {
4306         $canv2 delete secsel
4307         set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
4308                    -outline {{}} -tags secsel \
4309                    -fill [$canv2 cget -selectbackground]]
4310         $canv2 lower $t
4311     }
4312 }
4313
4314 proc unbolden {} {
4315     global boldids
4316
4317     set stillbold {}
4318     foreach id $boldids {
4319         if {![ishighlighted $id]} {
4320             bolden $id mainfont
4321         } else {
4322             lappend stillbold $id
4323         }
4324     }
4325     set boldids $stillbold
4326 }
4327
4328 proc addvhighlight {n} {
4329     global hlview viewcomplete curview vhl_done commitidx
4330
4331     if {[info exists hlview]} {
4332         delvhighlight
4333     }
4334     set hlview $n
4335     if {$n != $curview && ![info exists viewcomplete($n)]} {
4336         start_rev_list $n
4337     }
4338     set vhl_done $commitidx($hlview)
4339     if {$vhl_done > 0} {
4340         drawvisible
4341     }
4342 }
4343
4344 proc delvhighlight {} {
4345     global hlview vhighlights
4346
4347     if {![info exists hlview]} return
4348     unset hlview
4349     catch {unset vhighlights}
4350     unbolden
4351 }
4352
4353 proc vhighlightmore {} {
4354     global hlview vhl_done commitidx vhighlights curview
4355
4356     set max $commitidx($hlview)
4357     set vr [visiblerows]
4358     set r0 [lindex $vr 0]
4359     set r1 [lindex $vr 1]
4360     for {set i $vhl_done} {$i < $max} {incr i} {
4361         set id [commitonrow $i $hlview]
4362         if {[commitinview $id $curview]} {
4363             set row [rowofcommit $id]
4364             if {$r0 <= $row && $row <= $r1} {
4365                 if {![highlighted $row]} {
4366                     bolden $id mainfontbold
4367                 }
4368                 set vhighlights($id) 1
4369             }
4370         }
4371     }
4372     set vhl_done $max
4373     return 0
4374 }
4375
4376 proc askvhighlight {row id} {
4377     global hlview vhighlights iddrawn
4378
4379     if {[commitinview $id $hlview]} {
4380         if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
4381             bolden $id mainfontbold
4382         }
4383         set vhighlights($id) 1
4384     } else {
4385         set vhighlights($id) 0
4386     }
4387 }
4388
4389 proc hfiles_change {} {
4390     global highlight_files filehighlight fhighlights fh_serial
4391     global highlight_paths
4392
4393     if {[info exists filehighlight]} {
4394         # delete previous highlights
4395         catch {close $filehighlight}
4396         unset filehighlight
4397         catch {unset fhighlights}
4398         unbolden
4399         unhighlight_filelist
4400     }
4401     set highlight_paths {}
4402     after cancel do_file_hl $fh_serial
4403     incr fh_serial
4404     if {$highlight_files ne {}} {
4405         after 300 do_file_hl $fh_serial
4406     }
4407 }
4408
4409 proc gdttype_change {name ix op} {
4410     global gdttype highlight_files findstring findpattern
4411
4412     stopfinding
4413     if {$findstring ne {}} {
4414         if {$gdttype eq [mc "containing:"]} {
4415             if {$highlight_files ne {}} {
4416                 set highlight_files {}
4417                 hfiles_change
4418             }
4419             findcom_change
4420         } else {
4421             if {$findpattern ne {}} {
4422                 set findpattern {}
4423                 findcom_change
4424             }
4425             set highlight_files $findstring
4426             hfiles_change
4427         }
4428         drawvisible
4429     }
4430     # enable/disable findtype/findloc menus too
4431 }
4432
4433 proc find_change {name ix op} {
4434     global gdttype findstring highlight_files
4435
4436     stopfinding
4437     if {$gdttype eq [mc "containing:"]} {
4438         findcom_change
4439     } else {
4440         if {$highlight_files ne $findstring} {
4441             set highlight_files $findstring
4442             hfiles_change
4443         }
4444     }
4445     drawvisible
4446 }
4447
4448 proc findcom_change args {
4449     global nhighlights boldnameids
4450     global findpattern findtype findstring gdttype
4451
4452     stopfinding
4453     # delete previous highlights, if any
4454     foreach id $boldnameids {
4455         bolden_name $id mainfont
4456     }
4457     set boldnameids {}
4458     catch {unset nhighlights}
4459     unbolden
4460     unmarkmatches
4461     if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
4462         set findpattern {}
4463     } elseif {$findtype eq [mc "Regexp"]} {
4464         set findpattern $findstring
4465     } else {
4466         set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4467                    $findstring]
4468         set findpattern "*$e*"
4469     }
4470 }
4471
4472 proc makepatterns {l} {
4473     set ret {}
4474     foreach e $l {
4475         set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4476         if {[string index $ee end] eq "/"} {
4477             lappend ret "$ee*"
4478         } else {
4479             lappend ret $ee
4480             lappend ret "$ee/*"
4481         }
4482     }
4483     return $ret
4484 }
4485
4486 proc do_file_hl {serial} {
4487     global highlight_files filehighlight highlight_paths gdttype fhl_list
4488
4489     if {$gdttype eq [mc "touching paths:"]} {
4490         if {[catch {set paths [shellsplit $highlight_files]}]} return
4491         set highlight_paths [makepatterns $paths]
4492         highlight_filelist
4493         set gdtargs [concat -- $paths]
4494     } elseif {$gdttype eq [mc "adding/removing string:"]} {
4495         set gdtargs [list "-S$highlight_files"]
4496     } else {
4497         # must be "containing:", i.e. we're searching commit info
4498         return
4499     }
4500     set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
4501     set filehighlight [open $cmd r+]
4502     fconfigure $filehighlight -blocking 0
4503     filerun $filehighlight readfhighlight
4504     set fhl_list {}
4505     drawvisible
4506     flushhighlights
4507 }
4508
4509 proc flushhighlights {} {
4510     global filehighlight fhl_list
4511
4512     if {[info exists filehighlight]} {
4513         lappend fhl_list {}
4514         puts $filehighlight ""
4515         flush $filehighlight
4516     }
4517 }
4518
4519 proc askfilehighlight {row id} {
4520     global filehighlight fhighlights fhl_list
4521
4522     lappend fhl_list $id
4523     set fhighlights($id) -1
4524     puts $filehighlight $id
4525 }
4526
4527 proc readfhighlight {} {
4528     global filehighlight fhighlights curview iddrawn
4529     global fhl_list find_dirn
4530
4531     if {![info exists filehighlight]} {
4532         return 0
4533     }
4534     set nr 0
4535     while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4536         set line [string trim $line]
4537         set i [lsearch -exact $fhl_list $line]
4538         if {$i < 0} continue
4539         for {set j 0} {$j < $i} {incr j} {
4540             set id [lindex $fhl_list $j]
4541             set fhighlights($id) 0
4542         }
4543         set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4544         if {$line eq {}} continue
4545         if {![commitinview $line $curview]} continue
4546         if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4547             bolden $line mainfontbold
4548         }
4549         set fhighlights($line) 1
4550     }
4551     if {[eof $filehighlight]} {
4552         # strange...
4553         puts "oops, git diff-tree died"
4554         catch {close $filehighlight}
4555         unset filehighlight
4556         return 0
4557     }
4558     if {[info exists find_dirn]} {
4559         run findmore
4560     }
4561     return 1
4562 }
4563
4564 proc doesmatch {f} {
4565     global findtype findpattern
4566
4567     if {$findtype eq [mc "Regexp"]} {
4568         return [regexp $findpattern $f]
4569     } elseif {$findtype eq [mc "IgnCase"]} {
4570         return [string match -nocase $findpattern $f]
4571     } else {
4572         return [string match $findpattern $f]
4573     }
4574 }
4575
4576 proc askfindhighlight {row id} {
4577     global nhighlights commitinfo iddrawn
4578     global findloc
4579     global markingmatches
4580
4581     if {![info exists commitinfo($id)]} {
4582         getcommit $id
4583     }
4584     set info $commitinfo($id)
4585     set isbold 0
4586     set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
4587     foreach f $info ty $fldtypes {
4588         if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4589             [doesmatch $f]} {
4590             if {$ty eq [mc "Author"]} {
4591                 set isbold 2
4592                 break
4593             }
4594             set isbold 1
4595         }
4596     }
4597     if {$isbold && [info exists iddrawn($id)]} {
4598         if {![ishighlighted $id]} {
4599             bolden $id mainfontbold
4600             if {$isbold > 1} {
4601                 bolden_name $id mainfontbold
4602             }
4603         }
4604         if {$markingmatches} {
4605             markrowmatches $row $id
4606         }
4607     }
4608     set nhighlights($id) $isbold
4609 }
4610
4611 proc markrowmatches {row id} {
4612     global canv canv2 linehtag linentag commitinfo findloc
4613
4614     set headline [lindex $commitinfo($id) 0]
4615     set author [lindex $commitinfo($id) 1]
4616     $canv delete match$row
4617     $canv2 delete match$row
4618     if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4619         set m [findmatches $headline]
4620         if {$m ne {}} {
4621             markmatches $canv $row $headline $linehtag($id) $m \
4622                 [$canv itemcget $linehtag($id) -font] $row
4623         }
4624     }
4625     if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4626         set m [findmatches $author]
4627         if {$m ne {}} {
4628             markmatches $canv2 $row $author $linentag($id) $m \
4629                 [$canv2 itemcget $linentag($id) -font] $row
4630         }
4631     }
4632 }
4633
4634 proc vrel_change {name ix op} {
4635     global highlight_related
4636
4637     rhighlight_none
4638     if {$highlight_related ne [mc "None"]} {
4639         run drawvisible
4640     }
4641 }
4642
4643 # prepare for testing whether commits are descendents or ancestors of a
4644 proc rhighlight_sel {a} {
4645     global descendent desc_todo ancestor anc_todo
4646     global highlight_related
4647
4648     catch {unset descendent}
4649     set desc_todo [list $a]
4650     catch {unset ancestor}
4651     set anc_todo [list $a]
4652     if {$highlight_related ne [mc "None"]} {
4653         rhighlight_none
4654         run drawvisible
4655     }
4656 }
4657
4658 proc rhighlight_none {} {
4659     global rhighlights
4660
4661     catch {unset rhighlights}
4662     unbolden
4663 }
4664
4665 proc is_descendent {a} {
4666     global curview children descendent desc_todo
4667
4668     set v $curview
4669     set la [rowofcommit $a]
4670     set todo $desc_todo
4671     set leftover {}
4672     set done 0
4673     for {set i 0} {$i < [llength $todo]} {incr i} {
4674         set do [lindex $todo $i]
4675         if {[rowofcommit $do] < $la} {
4676             lappend leftover $do
4677             continue
4678         }
4679         foreach nk $children($v,$do) {
4680             if {![info exists descendent($nk)]} {
4681                 set descendent($nk) 1
4682                 lappend todo $nk
4683                 if {$nk eq $a} {
4684                     set done 1
4685                 }
4686             }
4687         }
4688         if {$done} {
4689             set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4690             return
4691         }
4692     }
4693     set descendent($a) 0
4694     set desc_todo $leftover
4695 }
4696
4697 proc is_ancestor {a} {
4698     global curview parents ancestor anc_todo
4699
4700     set v $curview
4701     set la [rowofcommit $a]
4702     set todo $anc_todo
4703     set leftover {}
4704     set done 0
4705     for {set i 0} {$i < [llength $todo]} {incr i} {
4706         set do [lindex $todo $i]
4707         if {![commitinview $do $v] || [rowofcommit $do] > $la} {
4708             lappend leftover $do
4709             continue
4710         }
4711         foreach np $parents($v,$do) {
4712             if {![info exists ancestor($np)]} {
4713                 set ancestor($np) 1
4714                 lappend todo $np
4715                 if {$np eq $a} {
4716                     set done 1
4717                 }
4718             }
4719         }
4720         if {$done} {
4721             set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4722             return
4723         }
4724     }
4725     set ancestor($a) 0
4726     set anc_todo $leftover
4727 }
4728
4729 proc askrelhighlight {row id} {
4730     global descendent highlight_related iddrawn rhighlights
4731     global selectedline ancestor
4732
4733     if {$selectedline eq {}} return
4734     set isbold 0
4735     if {$highlight_related eq [mc "Descendant"] ||
4736         $highlight_related eq [mc "Not descendant"]} {
4737         if {![info exists descendent($id)]} {
4738             is_descendent $id
4739         }
4740         if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
4741             set isbold 1
4742         }
4743     } elseif {$highlight_related eq [mc "Ancestor"] ||
4744               $highlight_related eq [mc "Not ancestor"]} {
4745         if {![info exists ancestor($id)]} {
4746             is_ancestor $id
4747         }
4748         if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
4749             set isbold 1
4750         }
4751     }
4752     if {[info exists iddrawn($id)]} {
4753         if {$isbold && ![ishighlighted $id]} {
4754             bolden $id mainfontbold
4755         }
4756     }
4757     set rhighlights($id) $isbold
4758 }
4759
4760 # Graph layout functions
4761
4762 proc shortids {ids} {
4763     set res {}
4764     foreach id $ids {
4765         if {[llength $id] > 1} {
4766             lappend res [shortids $id]
4767         } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
4768             lappend res [string range $id 0 7]
4769         } else {
4770             lappend res $id
4771         }
4772     }
4773     return $res
4774 }
4775
4776 proc ntimes {n o} {
4777     set ret {}
4778     set o [list $o]
4779     for {set mask 1} {$mask <= $n} {incr mask $mask} {
4780         if {($n & $mask) != 0} {
4781             set ret [concat $ret $o]
4782         }
4783         set o [concat $o $o]
4784     }
4785     return $ret
4786 }
4787
4788 proc ordertoken {id} {
4789     global ordertok curview varcid varcstart varctok curview parents children
4790     global nullid nullid2
4791
4792     if {[info exists ordertok($id)]} {
4793         return $ordertok($id)
4794     }
4795     set origid $id
4796     set todo {}
4797     while {1} {
4798         if {[info exists varcid($curview,$id)]} {
4799             set a $varcid($curview,$id)
4800             set p [lindex $varcstart($curview) $a]
4801         } else {
4802             set p [lindex $children($curview,$id) 0]
4803         }
4804         if {[info exists ordertok($p)]} {
4805             set tok $ordertok($p)
4806             break
4807         }
4808         set id [first_real_child $curview,$p]
4809         if {$id eq {}} {
4810             # it's a root
4811             set tok [lindex $varctok($curview) $varcid($curview,$p)]
4812             break
4813         }
4814         if {[llength $parents($curview,$id)] == 1} {
4815             lappend todo [list $p {}]
4816         } else {
4817             set j [lsearch -exact $parents($curview,$id) $p]
4818             if {$j < 0} {
4819                 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
4820             }
4821             lappend todo [list $p [strrep $j]]
4822         }
4823     }
4824     for {set i [llength $todo]} {[incr i -1] >= 0} {} {
4825         set p [lindex $todo $i 0]
4826         append tok [lindex $todo $i 1]
4827         set ordertok($p) $tok
4828     }
4829     set ordertok($origid) $tok
4830     return $tok
4831 }
4832
4833 # Work out where id should go in idlist so that order-token
4834 # values increase from left to right
4835 proc idcol {idlist id {i 0}} {
4836     set t [ordertoken $id]
4837     if {$i < 0} {
4838         set i 0
4839     }
4840     if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
4841         if {$i > [llength $idlist]} {
4842             set i [llength $idlist]
4843         }
4844         while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
4845         incr i
4846     } else {
4847         if {$t > [ordertoken [lindex $idlist $i]]} {
4848             while {[incr i] < [llength $idlist] &&
4849                    $t >= [ordertoken [lindex $idlist $i]]} {}
4850         }
4851     }
4852     return $i
4853 }
4854
4855 proc initlayout {} {
4856     global rowidlist rowisopt rowfinal displayorder parentlist
4857     global numcommits canvxmax canv
4858     global nextcolor
4859     global colormap rowtextx
4860
4861     set numcommits 0
4862     set displayorder {}
4863     set parentlist {}
4864     set nextcolor 0
4865     set rowidlist {}
4866     set rowisopt {}
4867     set rowfinal {}
4868     set canvxmax [$canv cget -width]
4869     catch {unset colormap}
4870     catch {unset rowtextx}
4871     setcanvscroll
4872 }
4873
4874 proc setcanvscroll {} {
4875     global canv canv2 canv3 numcommits linespc canvxmax canvy0
4876     global lastscrollset lastscrollrows
4877
4878     set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
4879     $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
4880     $canv2 conf -scrollregion [list 0 0 0 $ymax]
4881     $canv3 conf -scrollregion [list 0 0 0 $ymax]
4882     set lastscrollset [clock clicks -milliseconds]
4883     set lastscrollrows $numcommits
4884 }
4885
4886 proc visiblerows {} {
4887     global canv numcommits linespc
4888
4889     set ymax [lindex [$canv cget -scrollregion] 3]
4890     if {$ymax eq {} || $ymax == 0} return
4891     set f [$canv yview]
4892     set y0 [expr {int([lindex $f 0] * $ymax)}]
4893     set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
4894     if {$r0 < 0} {
4895         set r0 0
4896     }
4897     set y1 [expr {int([lindex $f 1] * $ymax)}]
4898     set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
4899     if {$r1 >= $numcommits} {
4900         set r1 [expr {$numcommits - 1}]
4901     }
4902     return [list $r0 $r1]
4903 }
4904
4905 proc layoutmore {} {
4906     global commitidx viewcomplete curview
4907     global numcommits pending_select curview
4908     global lastscrollset lastscrollrows
4909
4910     if {$lastscrollrows < 100 || $viewcomplete($curview) ||
4911         [clock clicks -milliseconds] - $lastscrollset > 500} {
4912         setcanvscroll
4913     }
4914     if {[info exists pending_select] &&
4915         [commitinview $pending_select $curview]} {
4916         update
4917         selectline [rowofcommit $pending_select] 1
4918     }
4919     drawvisible
4920 }
4921
4922 # With path limiting, we mightn't get the actual HEAD commit,
4923 # so ask git rev-list what is the first ancestor of HEAD that
4924 # touches a file in the path limit.
4925 proc get_viewmainhead {view} {
4926     global viewmainheadid vfilelimit viewinstances mainheadid
4927
4928     catch {
4929         set rfd [open [concat | git rev-list -1 $mainheadid \
4930                            -- $vfilelimit($view)] r]
4931         set j [reg_instance $rfd]
4932         lappend viewinstances($view) $j
4933         fconfigure $rfd -blocking 0
4934         filerun $rfd [list getviewhead $rfd $j $view]
4935         set viewmainheadid($curview) {}
4936     }
4937 }
4938
4939 # git rev-list should give us just 1 line to use as viewmainheadid($view)
4940 proc getviewhead {fd inst view} {
4941     global viewmainheadid commfd curview viewinstances showlocalchanges
4942
4943     set id {}
4944     if {[gets $fd line] < 0} {
4945         if {![eof $fd]} {
4946             return 1
4947         }
4948     } elseif {[string length $line] == 40 && [string is xdigit $line]} {
4949         set id $line
4950     }
4951     set viewmainheadid($view) $id
4952     close $fd
4953     unset commfd($inst)
4954     set i [lsearch -exact $viewinstances($view) $inst]
4955     if {$i >= 0} {
4956         set viewinstances($view) [lreplace $viewinstances($view) $i $i]
4957     }
4958     if {$showlocalchanges && $id ne {} && $view == $curview} {
4959         doshowlocalchanges
4960     }
4961     return 0
4962 }
4963
4964 proc doshowlocalchanges {} {
4965     global curview viewmainheadid
4966
4967     if {$viewmainheadid($curview) eq {}} return
4968     if {[commitinview $viewmainheadid($curview) $curview]} {
4969         dodiffindex
4970     } else {
4971         interestedin $viewmainheadid($curview) dodiffindex
4972     }
4973 }
4974
4975 proc dohidelocalchanges {} {
4976     global nullid nullid2 lserial curview
4977
4978     if {[commitinview $nullid $curview]} {
4979         removefakerow $nullid
4980     }
4981     if {[commitinview $nullid2 $curview]} {
4982         removefakerow $nullid2
4983     }
4984     incr lserial
4985 }
4986
4987 # spawn off a process to do git diff-index --cached HEAD
4988 proc dodiffindex {} {
4989     global lserial showlocalchanges vfilelimit curview
4990     global isworktree
4991
4992     if {!$showlocalchanges || !$isworktree} return
4993     incr lserial
4994     set cmd "|git diff-index --cached HEAD"
4995     if {$vfilelimit($curview) ne {}} {
4996         set cmd [concat $cmd -- $vfilelimit($curview)]
4997     }
4998     set fd [open $cmd r]
4999     fconfigure $fd -blocking 0
5000     set i [reg_instance $fd]
5001     filerun $fd [list readdiffindex $fd $lserial $i]
5002 }
5003
5004 proc readdiffindex {fd serial inst} {
5005     global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
5006     global vfilelimit
5007
5008     set isdiff 1
5009     if {[gets $fd line] < 0} {
5010         if {![eof $fd]} {
5011             return 1
5012         }
5013         set isdiff 0
5014     }
5015     # we only need to see one line and we don't really care what it says...
5016     stop_instance $inst
5017
5018     if {$serial != $lserial} {
5019         return 0
5020     }
5021
5022     # now see if there are any local changes not checked in to the index
5023     set cmd "|git diff-files"
5024     if {$vfilelimit($curview) ne {}} {
5025         set cmd [concat $cmd -- $vfilelimit($curview)]
5026     }
5027     set fd [open $cmd r]
5028     fconfigure $fd -blocking 0
5029     set i [reg_instance $fd]
5030     filerun $fd [list readdifffiles $fd $serial $i]
5031
5032     if {$isdiff && ![commitinview $nullid2 $curview]} {
5033         # add the line for the changes in the index to the graph
5034         set hl [mc "Local changes checked in to index but not committed"]
5035         set commitinfo($nullid2) [list  $hl {} {} {} {} "    $hl\n"]
5036         set commitdata($nullid2) "\n    $hl\n"
5037         if {[commitinview $nullid $curview]} {
5038             removefakerow $nullid
5039         }
5040         insertfakerow $nullid2 $viewmainheadid($curview)
5041     } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
5042         if {[commitinview $nullid $curview]} {
5043             removefakerow $nullid
5044         }
5045         removefakerow $nullid2
5046     }
5047     return 0
5048 }
5049
5050 proc readdifffiles {fd serial inst} {
5051     global viewmainheadid nullid nullid2 curview
5052     global commitinfo commitdata lserial
5053
5054     set isdiff 1
5055     if {[gets $fd line] < 0} {
5056         if {![eof $fd]} {
5057             return 1
5058         }
5059         set isdiff 0
5060     }
5061     # we only need to see one line and we don't really care what it says...
5062     stop_instance $inst
5063
5064     if {$serial != $lserial} {
5065         return 0
5066     }
5067
5068     if {$isdiff && ![commitinview $nullid $curview]} {
5069         # add the line for the local diff to the graph
5070         set hl [mc "Local uncommitted changes, not checked in to index"]
5071         set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
5072         set commitdata($nullid) "\n    $hl\n"
5073         if {[commitinview $nullid2 $curview]} {
5074             set p $nullid2
5075         } else {
5076             set p $viewmainheadid($curview)
5077         }
5078         insertfakerow $nullid $p
5079     } elseif {!$isdiff && [commitinview $nullid $curview]} {
5080         removefakerow $nullid
5081     }
5082     return 0
5083 }
5084
5085 proc nextuse {id row} {
5086     global curview children
5087
5088     if {[info exists children($curview,$id)]} {
5089         foreach kid $children($curview,$id) {
5090             if {![commitinview $kid $curview]} {
5091                 return -1
5092             }
5093             if {[rowofcommit $kid] > $row} {
5094                 return [rowofcommit $kid]
5095             }
5096         }
5097     }
5098     if {[commitinview $id $curview]} {
5099         return [rowofcommit $id]
5100     }
5101     return -1
5102 }
5103
5104 proc prevuse {id row} {
5105     global curview children
5106
5107     set ret -1
5108     if {[info exists children($curview,$id)]} {
5109         foreach kid $children($curview,$id) {
5110             if {![commitinview $kid $curview]} break
5111             if {[rowofcommit $kid] < $row} {
5112                 set ret [rowofcommit $kid]
5113             }
5114         }
5115     }
5116     return $ret
5117 }
5118
5119 proc make_idlist {row} {
5120     global displayorder parentlist uparrowlen downarrowlen mingaplen
5121     global commitidx curview children
5122
5123     set r [expr {$row - $mingaplen - $downarrowlen - 1}]
5124     if {$r < 0} {
5125         set r 0
5126     }
5127     set ra [expr {$row - $downarrowlen}]
5128     if {$ra < 0} {
5129         set ra 0
5130     }
5131     set rb [expr {$row + $uparrowlen}]
5132     if {$rb > $commitidx($curview)} {
5133         set rb $commitidx($curview)
5134     }
5135     make_disporder $r [expr {$rb + 1}]
5136     set ids {}
5137     for {} {$r < $ra} {incr r} {
5138         set nextid [lindex $displayorder [expr {$r + 1}]]
5139         foreach p [lindex $parentlist $r] {
5140             if {$p eq $nextid} continue
5141             set rn [nextuse $p $r]
5142             if {$rn >= $row &&
5143                 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
5144                 lappend ids [list [ordertoken $p] $p]
5145             }
5146         }
5147     }
5148     for {} {$r < $row} {incr r} {
5149         set nextid [lindex $displayorder [expr {$r + 1}]]
5150         foreach p [lindex $parentlist $r] {
5151             if {$p eq $nextid} continue
5152             set rn [nextuse $p $r]
5153             if {$rn < 0 || $rn >= $row} {
5154                 lappend ids [list [ordertoken $p] $p]
5155             }
5156         }
5157     }
5158     set id [lindex $displayorder $row]
5159     lappend ids [list [ordertoken $id] $id]
5160     while {$r < $rb} {
5161         foreach p [lindex $parentlist $r] {
5162             set firstkid [lindex $children($curview,$p) 0]
5163             if {[rowofcommit $firstkid] < $row} {
5164                 lappend ids [list [ordertoken $p] $p]
5165             }
5166         }
5167         incr r
5168         set id [lindex $displayorder $r]
5169         if {$id ne {}} {
5170             set firstkid [lindex $children($curview,$id) 0]
5171             if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
5172                 lappend ids [list [ordertoken $id] $id]
5173             }
5174         }
5175     }
5176     set idlist {}
5177     foreach idx [lsort -unique $ids] {
5178         lappend idlist [lindex $idx 1]
5179     }
5180     return $idlist
5181 }
5182
5183 proc rowsequal {a b} {
5184     while {[set i [lsearch -exact $a {}]] >= 0} {
5185         set a [lreplace $a $i $i]
5186     }
5187     while {[set i [lsearch -exact $b {}]] >= 0} {
5188         set b [lreplace $b $i $i]
5189     }
5190     return [expr {$a eq $b}]
5191 }
5192
5193 proc makeupline {id row rend col} {
5194     global rowidlist uparrowlen downarrowlen mingaplen
5195
5196     for {set r $rend} {1} {set r $rstart} {
5197         set rstart [prevuse $id $r]
5198         if {$rstart < 0} return
5199         if {$rstart < $row} break
5200     }
5201     if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5202         set rstart [expr {$rend - $uparrowlen - 1}]
5203     }
5204     for {set r $rstart} {[incr r] <= $row} {} {
5205         set idlist [lindex $rowidlist $r]
5206         if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5207             set col [idcol $idlist $id $col]
5208             lset rowidlist $r [linsert $idlist $col $id]
5209             changedrow $r
5210         }
5211     }
5212 }
5213
5214 proc layoutrows {row endrow} {
5215     global rowidlist rowisopt rowfinal displayorder
5216     global uparrowlen downarrowlen maxwidth mingaplen
5217     global children parentlist
5218     global commitidx viewcomplete curview
5219
5220     make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
5221     set idlist {}
5222     if {$row > 0} {
5223         set rm1 [expr {$row - 1}]
5224         foreach id [lindex $rowidlist $rm1] {
5225             if {$id ne {}} {
5226                 lappend idlist $id
5227             }
5228         }
5229         set final [lindex $rowfinal $rm1]
5230     }
5231     for {} {$row < $endrow} {incr row} {
5232         set rm1 [expr {$row - 1}]
5233         if {$rm1 < 0 || $idlist eq {}} {
5234             set idlist [make_idlist $row]
5235             set final 1
5236         } else {
5237             set id [lindex $displayorder $rm1]
5238             set col [lsearch -exact $idlist $id]
5239             set idlist [lreplace $idlist $col $col]
5240             foreach p [lindex $parentlist $rm1] {
5241                 if {[lsearch -exact $idlist $p] < 0} {
5242                     set col [idcol $idlist $p $col]
5243                     set idlist [linsert $idlist $col $p]
5244                     # if not the first child, we have to insert a line going up
5245                     if {$id ne [lindex $children($curview,$p) 0]} {
5246                         makeupline $p $rm1 $row $col
5247                     }
5248                 }
5249             }
5250             set id [lindex $displayorder $row]
5251             if {$row > $downarrowlen} {
5252                 set termrow [expr {$row - $downarrowlen - 1}]
5253                 foreach p [lindex $parentlist $termrow] {
5254                     set i [lsearch -exact $idlist $p]
5255                     if {$i < 0} continue
5256                     set nr [nextuse $p $termrow]
5257                     if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5258                         set idlist [lreplace $idlist $i $i]
5259                     }
5260                 }
5261             }
5262             set col [lsearch -exact $idlist $id]
5263             if {$col < 0} {
5264                 set col [idcol $idlist $id]
5265                 set idlist [linsert $idlist $col $id]
5266                 if {$children($curview,$id) ne {}} {
5267                     makeupline $id $rm1 $row $col
5268                 }
5269             }
5270             set r [expr {$row + $uparrowlen - 1}]
5271             if {$r < $commitidx($curview)} {
5272                 set x $col
5273                 foreach p [lindex $parentlist $r] {
5274                     if {[lsearch -exact $idlist $p] >= 0} continue
5275                     set fk [lindex $children($curview,$p) 0]
5276                     if {[rowofcommit $fk] < $row} {
5277                         set x [idcol $idlist $p $x]
5278                         set idlist [linsert $idlist $x $p]
5279                     }
5280                 }
5281                 if {[incr r] < $commitidx($curview)} {
5282                     set p [lindex $displayorder $r]
5283                     if {[lsearch -exact $idlist $p] < 0} {
5284                         set fk [lindex $children($curview,$p) 0]
5285                         if {$fk ne {} && [rowofcommit $fk] < $row} {
5286                             set x [idcol $idlist $p $x]
5287                             set idlist [linsert $idlist $x $p]
5288                         }
5289                     }
5290                 }
5291             }
5292         }
5293         if {$final && !$viewcomplete($curview) &&
5294             $row + $uparrowlen + $mingaplen + $downarrowlen
5295                 >= $commitidx($curview)} {
5296             set final 0
5297         }
5298         set l [llength $rowidlist]
5299         if {$row == $l} {
5300             lappend rowidlist $idlist
5301             lappend rowisopt 0
5302             lappend rowfinal $final
5303         } elseif {$row < $l} {
5304             if {![rowsequal $idlist [lindex $rowidlist $row]]} {
5305                 lset rowidlist $row $idlist
5306                 changedrow $row
5307             }
5308             lset rowfinal $row $final
5309         } else {
5310             set pad [ntimes [expr {$row - $l}] {}]
5311             set rowidlist [concat $rowidlist $pad]
5312             lappend rowidlist $idlist
5313             set rowfinal [concat $rowfinal $pad]
5314             lappend rowfinal $final
5315             set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5316         }
5317     }
5318     return $row
5319 }
5320
5321 proc changedrow {row} {
5322     global displayorder iddrawn rowisopt need_redisplay
5323
5324     set l [llength $rowisopt]
5325     if {$row < $l} {
5326         lset rowisopt $row 0
5327         if {$row + 1 < $l} {
5328             lset rowisopt [expr {$row + 1}] 0
5329             if {$row + 2 < $l} {
5330                 lset rowisopt [expr {$row + 2}] 0
5331             }
5332         }
5333     }
5334     set id [lindex $displayorder $row]
5335     if {[info exists iddrawn($id)]} {
5336         set need_redisplay 1
5337     }
5338 }
5339
5340 proc insert_pad {row col npad} {
5341     global rowidlist
5342
5343     set pad [ntimes $npad {}]
5344     set idlist [lindex $rowidlist $row]
5345     set bef [lrange $idlist 0 [expr {$col - 1}]]
5346     set aft [lrange $idlist $col end]
5347     set i [lsearch -exact $aft {}]
5348     if {$i > 0} {
5349         set aft [lreplace $aft $i $i]
5350     }
5351     lset rowidlist $row [concat $bef $pad $aft]
5352     changedrow $row
5353 }
5354
5355 proc optimize_rows {row col endrow} {
5356     global rowidlist rowisopt displayorder curview children
5357
5358     if {$row < 1} {
5359         set row 1
5360     }
5361     for {} {$row < $endrow} {incr row; set col 0} {
5362         if {[lindex $rowisopt $row]} continue
5363         set haspad 0
5364         set y0 [expr {$row - 1}]
5365         set ym [expr {$row - 2}]
5366         set idlist [lindex $rowidlist $row]
5367         set previdlist [lindex $rowidlist $y0]
5368         if {$idlist eq {} || $previdlist eq {}} continue
5369         if {$ym >= 0} {
5370             set pprevidlist [lindex $rowidlist $ym]
5371             if {$pprevidlist eq {}} continue
5372         } else {
5373             set pprevidlist {}
5374         }
5375         set x0 -1
5376         set xm -1
5377         for {} {$col < [llength $idlist]} {incr col} {
5378             set id [lindex $idlist $col]
5379             if {[lindex $previdlist $col] eq $id} continue
5380             if {$id eq {}} {
5381                 set haspad 1
5382                 continue
5383             }
5384             set x0 [lsearch -exact $previdlist $id]
5385             if {$x0 < 0} continue
5386             set z [expr {$x0 - $col}]
5387             set isarrow 0
5388             set z0 {}
5389             if {$ym >= 0} {
5390                 set xm [lsearch -exact $pprevidlist $id]
5391                 if {$xm >= 0} {
5392                     set z0 [expr {$xm - $x0}]
5393                 }
5394             }
5395             if {$z0 eq {}} {
5396                 # if row y0 is the first child of $id then it's not an arrow
5397                 if {[lindex $children($curview,$id) 0] ne
5398                     [lindex $displayorder $y0]} {
5399                     set isarrow 1
5400                 }
5401             }
5402             if {!$isarrow && $id ne [lindex $displayorder $row] &&
5403                 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5404                 set isarrow 1
5405             }
5406             # Looking at lines from this row to the previous row,
5407             # make them go straight up if they end in an arrow on
5408             # the previous row; otherwise make them go straight up
5409             # or at 45 degrees.
5410             if {$z < -1 || ($z < 0 && $isarrow)} {
5411                 # Line currently goes left too much;
5412                 # insert pads in the previous row, then optimize it
5413                 set npad [expr {-1 - $z + $isarrow}]
5414                 insert_pad $y0 $x0 $npad
5415                 if {$y0 > 0} {
5416                     optimize_rows $y0 $x0 $row
5417                 }
5418                 set previdlist [lindex $rowidlist $y0]
5419                 set x0 [lsearch -exact $previdlist $id]
5420                 set z [expr {$x0 - $col}]
5421                 if {$z0 ne {}} {
5422                     set pprevidlist [lindex $rowidlist $ym]
5423                     set xm [lsearch -exact $pprevidlist $id]
5424                     set z0 [expr {$xm - $x0}]
5425                 }
5426             } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5427                 # Line currently goes right too much;
5428                 # insert pads in this line
5429                 set npad [expr {$z - 1 + $isarrow}]
5430                 insert_pad $row $col $npad
5431                 set idlist [lindex $rowidlist $row]
5432                 incr col $npad
5433                 set z [expr {$x0 - $col}]
5434                 set haspad 1
5435             }
5436             if {$z0 eq {} && !$isarrow && $ym >= 0} {
5437                 # this line links to its first child on row $row-2
5438                 set id [lindex $displayorder $ym]
5439                 set xc [lsearch -exact $pprevidlist $id]
5440                 if {$xc >= 0} {
5441                     set z0 [expr {$xc - $x0}]
5442                 }
5443             }
5444             # avoid lines jigging left then immediately right
5445             if {$z0 ne {} && $z < 0 && $z0 > 0} {
5446                 insert_pad $y0 $x0 1
5447                 incr x0
5448                 optimize_rows $y0 $x0 $row
5449                 set previdlist [lindex $rowidlist $y0]
5450             }
5451         }
5452         if {!$haspad} {
5453             # Find the first column that doesn't have a line going right
5454             for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5455                 set id [lindex $idlist $col]
5456                 if {$id eq {}} break
5457                 set x0 [lsearch -exact $previdlist $id]
5458                 if {$x0 < 0} {
5459                     # check if this is the link to the first child
5460                     set kid [lindex $displayorder $y0]
5461                     if {[lindex $children($curview,$id) 0] eq $kid} {
5462                         # it is, work out offset to child
5463                         set x0 [lsearch -exact $previdlist $kid]
5464                     }
5465                 }
5466                 if {$x0 <= $col} break
5467             }
5468             # Insert a pad at that column as long as it has a line and
5469             # isn't the last column
5470             if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5471                 set idlist [linsert $idlist $col {}]
5472                 lset rowidlist $row $idlist
5473                 changedrow $row
5474             }
5475         }
5476     }
5477 }
5478
5479 proc xc {row col} {
5480     global canvx0 linespc
5481     return [expr {$canvx0 + $col * $linespc}]
5482 }
5483
5484 proc yc {row} {
5485     global canvy0 linespc
5486     return [expr {$canvy0 + $row * $linespc}]
5487 }
5488
5489 proc linewidth {id} {
5490     global thickerline lthickness
5491
5492     set wid $lthickness
5493     if {[info exists thickerline] && $id eq $thickerline} {
5494         set wid [expr {2 * $lthickness}]
5495     }
5496     return $wid
5497 }
5498
5499 proc rowranges {id} {
5500     global curview children uparrowlen downarrowlen
5501     global rowidlist
5502
5503     set kids $children($curview,$id)
5504     if {$kids eq {}} {
5505         return {}
5506     }
5507     set ret {}
5508     lappend kids $id
5509     foreach child $kids {
5510         if {![commitinview $child $curview]} break
5511         set row [rowofcommit $child]
5512         if {![info exists prev]} {
5513             lappend ret [expr {$row + 1}]
5514         } else {
5515             if {$row <= $prevrow} {
5516                 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5517             }
5518             # see if the line extends the whole way from prevrow to row
5519             if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5520                 [lsearch -exact [lindex $rowidlist \
5521                             [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5522                 # it doesn't, see where it ends
5523                 set r [expr {$prevrow + $downarrowlen}]
5524                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5525                     while {[incr r -1] > $prevrow &&
5526                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5527                 } else {
5528                     while {[incr r] <= $row &&
5529                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5530                     incr r -1
5531                 }
5532                 lappend ret $r
5533                 # see where it starts up again
5534                 set r [expr {$row - $uparrowlen}]
5535                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5536                     while {[incr r] < $row &&
5537                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5538                 } else {
5539                     while {[incr r -1] >= $prevrow &&
5540                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5541                     incr r
5542                 }
5543                 lappend ret $r
5544             }
5545         }
5546         if {$child eq $id} {
5547             lappend ret $row
5548         }
5549         set prev $child
5550         set prevrow $row
5551     }
5552     return $ret
5553 }
5554
5555 proc drawlineseg {id row endrow arrowlow} {
5556     global rowidlist displayorder iddrawn linesegs
5557     global canv colormap linespc curview maxlinelen parentlist
5558
5559     set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5560     set le [expr {$row + 1}]
5561     set arrowhigh 1
5562     while {1} {
5563         set c [lsearch -exact [lindex $rowidlist $le] $id]
5564         if {$c < 0} {
5565             incr le -1
5566             break
5567         }
5568         lappend cols $c
5569         set x [lindex $displayorder $le]
5570         if {$x eq $id} {
5571             set arrowhigh 0
5572             break
5573         }
5574         if {[info exists iddrawn($x)] || $le == $endrow} {
5575             set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5576             if {$c >= 0} {
5577                 lappend cols $c
5578                 set arrowhigh 0
5579             }
5580             break
5581         }
5582         incr le
5583     }
5584     if {$le <= $row} {
5585         return $row
5586     }
5587
5588     set lines {}
5589     set i 0
5590     set joinhigh 0
5591     if {[info exists linesegs($id)]} {
5592         set lines $linesegs($id)
5593         foreach li $lines {
5594             set r0 [lindex $li 0]
5595             if {$r0 > $row} {
5596                 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5597                     set joinhigh 1
5598                 }
5599                 break
5600             }
5601             incr i
5602         }
5603     }
5604     set joinlow 0
5605     if {$i > 0} {
5606         set li [lindex $lines [expr {$i-1}]]
5607         set r1 [lindex $li 1]
5608         if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5609             set joinlow 1
5610         }
5611     }
5612
5613     set x [lindex $cols [expr {$le - $row}]]
5614     set xp [lindex $cols [expr {$le - 1 - $row}]]
5615     set dir [expr {$xp - $x}]
5616     if {$joinhigh} {
5617         set ith [lindex $lines $i 2]
5618         set coords [$canv coords $ith]
5619         set ah [$canv itemcget $ith -arrow]
5620         set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5621         set x2 [lindex $cols [expr {$le + 1 - $row}]]
5622         if {$x2 ne {} && $x - $x2 == $dir} {
5623             set coords [lrange $coords 0 end-2]
5624         }
5625     } else {
5626         set coords [list [xc $le $x] [yc $le]]
5627     }
5628     if {$joinlow} {
5629         set itl [lindex $lines [expr {$i-1}] 2]
5630         set al [$canv itemcget $itl -arrow]
5631         set arrowlow [expr {$al eq "last" || $al eq "both"}]
5632     } elseif {$arrowlow} {
5633         if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5634             [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5635             set arrowlow 0
5636         }
5637     }
5638     set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5639     for {set y $le} {[incr y -1] > $row} {} {
5640         set x $xp
5641         set xp [lindex $cols [expr {$y - 1 - $row}]]
5642         set ndir [expr {$xp - $x}]
5643         if {$dir != $ndir || $xp < 0} {
5644             lappend coords [xc $y $x] [yc $y]
5645         }
5646         set dir $ndir
5647     }
5648     if {!$joinlow} {
5649         if {$xp < 0} {
5650             # join parent line to first child
5651             set ch [lindex $displayorder $row]
5652             set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5653             if {$xc < 0} {
5654                 puts "oops: drawlineseg: child $ch not on row $row"
5655             } elseif {$xc != $x} {
5656                 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5657                     set d [expr {int(0.5 * $linespc)}]
5658                     set x1 [xc $row $x]
5659                     if {$xc < $x} {
5660                         set x2 [expr {$x1 - $d}]
5661                     } else {
5662                         set x2 [expr {$x1 + $d}]
5663                     }
5664                     set y2 [yc $row]
5665                     set y1 [expr {$y2 + $d}]
5666                     lappend coords $x1 $y1 $x2 $y2
5667                 } elseif {$xc < $x - 1} {
5668                     lappend coords [xc $row [expr {$x-1}]] [yc $row]
5669                 } elseif {$xc > $x + 1} {
5670                     lappend coords [xc $row [expr {$x+1}]] [yc $row]
5671                 }
5672                 set x $xc
5673             }
5674             lappend coords [xc $row $x] [yc $row]
5675         } else {
5676             set xn [xc $row $xp]
5677             set yn [yc $row]
5678             lappend coords $xn $yn
5679         }
5680         if {!$joinhigh} {
5681             assigncolor $id
5682             set t [$canv create line $coords -width [linewidth $id] \
5683                        -fill $colormap($id) -tags lines.$id -arrow $arrow]
5684             $canv lower $t
5685             bindline $t $id
5686             set lines [linsert $lines $i [list $row $le $t]]
5687         } else {
5688             $canv coords $ith $coords
5689             if {$arrow ne $ah} {
5690                 $canv itemconf $ith -arrow $arrow
5691             }
5692             lset lines $i 0 $row
5693         }
5694     } else {
5695         set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
5696         set ndir [expr {$xo - $xp}]
5697         set clow [$canv coords $itl]
5698         if {$dir == $ndir} {
5699             set clow [lrange $clow 2 end]
5700         }
5701         set coords [concat $coords $clow]
5702         if {!$joinhigh} {
5703             lset lines [expr {$i-1}] 1 $le
5704         } else {
5705             # coalesce two pieces
5706             $canv delete $ith
5707             set b [lindex $lines [expr {$i-1}] 0]
5708             set e [lindex $lines $i 1]
5709             set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
5710         }
5711         $canv coords $itl $coords
5712         if {$arrow ne $al} {
5713             $canv itemconf $itl -arrow $arrow
5714         }
5715     }
5716
5717     set linesegs($id) $lines
5718     return $le
5719 }
5720
5721 proc drawparentlinks {id row} {
5722     global rowidlist canv colormap curview parentlist
5723     global idpos linespc
5724
5725     set rowids [lindex $rowidlist $row]
5726     set col [lsearch -exact $rowids $id]
5727     if {$col < 0} return
5728     set olds [lindex $parentlist $row]
5729     set row2 [expr {$row + 1}]
5730     set x [xc $row $col]
5731     set y [yc $row]
5732     set y2 [yc $row2]
5733     set d [expr {int(0.5 * $linespc)}]
5734     set ymid [expr {$y + $d}]
5735     set ids [lindex $rowidlist $row2]
5736     # rmx = right-most X coord used
5737     set rmx 0
5738     foreach p $olds {
5739         set i [lsearch -exact $ids $p]
5740         if {$i < 0} {
5741             puts "oops, parent $p of $id not in list"
5742             continue
5743         }
5744         set x2 [xc $row2 $i]
5745         if {$x2 > $rmx} {
5746             set rmx $x2
5747         }
5748         set j [lsearch -exact $rowids $p]
5749         if {$j < 0} {
5750             # drawlineseg will do this one for us
5751             continue
5752         }
5753         assigncolor $p
5754         # should handle duplicated parents here...
5755         set coords [list $x $y]
5756         if {$i != $col} {
5757             # if attaching to a vertical segment, draw a smaller
5758             # slant for visual distinctness
5759             if {$i == $j} {
5760                 if {$i < $col} {
5761                     lappend coords [expr {$x2 + $d}] $y $x2 $ymid
5762                 } else {
5763                     lappend coords [expr {$x2 - $d}] $y $x2 $ymid
5764                 }
5765             } elseif {$i < $col && $i < $j} {
5766                 # segment slants towards us already
5767                 lappend coords [xc $row $j] $y
5768             } else {
5769                 if {$i < $col - 1} {
5770                     lappend coords [expr {$x2 + $linespc}] $y
5771                 } elseif {$i > $col + 1} {
5772                     lappend coords [expr {$x2 - $linespc}] $y
5773                 }
5774                 lappend coords $x2 $y2
5775             }
5776         } else {
5777             lappend coords $x2 $y2
5778         }
5779         set t [$canv create line $coords -width [linewidth $p] \
5780                    -fill $colormap($p) -tags lines.$p]
5781         $canv lower $t
5782         bindline $t $p
5783     }
5784     if {$rmx > [lindex $idpos($id) 1]} {
5785         lset idpos($id) 1 $rmx
5786         redrawtags $id
5787     }
5788 }
5789
5790 proc drawlines {id} {
5791     global canv
5792
5793     $canv itemconf lines.$id -width [linewidth $id]
5794 }
5795
5796 proc drawcmittext {id row col} {
5797     global linespc canv canv2 canv3 fgcolor curview
5798     global cmitlisted commitinfo rowidlist parentlist
5799     global rowtextx idpos idtags idheads idotherrefs
5800     global linehtag linentag linedtag selectedline
5801     global canvxmax boldids boldnameids fgcolor markedid
5802     global mainheadid nullid nullid2 circleitem circlecolors ctxbut
5803
5804     # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
5805     set listed $cmitlisted($curview,$id)
5806     if {$id eq $nullid} {
5807         set ofill red
5808     } elseif {$id eq $nullid2} {
5809         set ofill green
5810     } elseif {$id eq $mainheadid} {
5811         set ofill yellow
5812     } else {
5813         set ofill [lindex $circlecolors $listed]
5814     }
5815     set x [xc $row $col]
5816     set y [yc $row]
5817     set orad [expr {$linespc / 3}]
5818     if {$listed <= 2} {
5819         set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
5820                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5821                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
5822     } elseif {$listed == 3} {
5823         # triangle pointing left for left-side commits
5824         set t [$canv create polygon \
5825                    [expr {$x - $orad}] $y \
5826                    [expr {$x + $orad - 1}] [expr {$y - $orad}] \
5827                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5828                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
5829     } else {
5830         # triangle pointing right for right-side commits
5831         set t [$canv create polygon \
5832                    [expr {$x + $orad - 1}] $y \
5833                    [expr {$x - $orad}] [expr {$y - $orad}] \
5834                    [expr {$x - $orad}] [expr {$y + $orad - 1}] \
5835                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
5836     }
5837     set circleitem($row) $t
5838     $canv raise $t
5839     $canv bind $t <1> {selcanvline {} %x %y}
5840     set rmx [llength [lindex $rowidlist $row]]
5841     set olds [lindex $parentlist $row]
5842     if {$olds ne {}} {
5843         set nextids [lindex $rowidlist [expr {$row + 1}]]
5844         foreach p $olds {
5845             set i [lsearch -exact $nextids $p]
5846             if {$i > $rmx} {
5847                 set rmx $i
5848             }
5849         }
5850     }
5851     set xt [xc $row $rmx]
5852     set rowtextx($row) $xt
5853     set idpos($id) [list $x $xt $y]
5854     if {[info exists idtags($id)] || [info exists idheads($id)]
5855         || [info exists idotherrefs($id)]} {
5856         set xt [drawtags $id $x $xt $y]
5857     }
5858     set headline [lindex $commitinfo($id) 0]
5859     set name [lindex $commitinfo($id) 1]
5860     set date [lindex $commitinfo($id) 2]
5861     set date [formatdate $date]
5862     set font mainfont
5863     set nfont mainfont
5864     set isbold [ishighlighted $id]
5865     if {$isbold > 0} {
5866         lappend boldids $id
5867         set font mainfontbold
5868         if {$isbold > 1} {
5869             lappend boldnameids $id
5870             set nfont mainfontbold
5871         }
5872     }
5873     set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
5874                            -text $headline -font $font -tags text]
5875     $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
5876     set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
5877                            -text $name -font $nfont -tags text]
5878     set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
5879                            -text $date -font mainfont -tags text]
5880     if {$selectedline == $row} {
5881         make_secsel $id
5882     }
5883     if {[info exists markedid] && $markedid eq $id} {
5884         make_idmark $id
5885     }
5886     set xr [expr {$xt + [font measure $font $headline]}]
5887     if {$xr > $canvxmax} {
5888         set canvxmax $xr
5889         setcanvscroll
5890     }
5891 }
5892
5893 proc drawcmitrow {row} {
5894     global displayorder rowidlist nrows_drawn
5895     global iddrawn markingmatches
5896     global commitinfo numcommits
5897     global filehighlight fhighlights findpattern nhighlights
5898     global hlview vhighlights
5899     global highlight_related rhighlights
5900
5901     if {$row >= $numcommits} return
5902
5903     set id [lindex $displayorder $row]
5904     if {[info exists hlview] && ![info exists vhighlights($id)]} {
5905         askvhighlight $row $id
5906     }
5907     if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
5908         askfilehighlight $row $id
5909     }
5910     if {$findpattern ne {} && ![info exists nhighlights($id)]} {
5911         askfindhighlight $row $id
5912     }
5913     if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
5914         askrelhighlight $row $id
5915     }
5916     if {![info exists iddrawn($id)]} {
5917         set col [lsearch -exact [lindex $rowidlist $row] $id]
5918         if {$col < 0} {
5919             puts "oops, row $row id $id not in list"
5920             return
5921         }
5922         if {![info exists commitinfo($id)]} {
5923             getcommit $id
5924         }
5925         assigncolor $id
5926         drawcmittext $id $row $col
5927         set iddrawn($id) 1
5928         incr nrows_drawn
5929     }
5930     if {$markingmatches} {
5931         markrowmatches $row $id
5932     }
5933 }
5934
5935 proc drawcommits {row {endrow {}}} {
5936     global numcommits iddrawn displayorder curview need_redisplay
5937     global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
5938
5939     if {$row < 0} {
5940         set row 0
5941     }
5942     if {$endrow eq {}} {
5943         set endrow $row
5944     }
5945     if {$endrow >= $numcommits} {
5946         set endrow [expr {$numcommits - 1}]
5947     }
5948
5949     set rl1 [expr {$row - $downarrowlen - 3}]
5950     if {$rl1 < 0} {
5951         set rl1 0
5952     }
5953     set ro1 [expr {$row - 3}]
5954     if {$ro1 < 0} {
5955         set ro1 0
5956     }
5957     set r2 [expr {$endrow + $uparrowlen + 3}]
5958     if {$r2 > $numcommits} {
5959         set r2 $numcommits
5960     }
5961     for {set r $rl1} {$r < $r2} {incr r} {
5962         if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
5963             if {$rl1 < $r} {
5964                 layoutrows $rl1 $r
5965             }
5966             set rl1 [expr {$r + 1}]
5967         }
5968     }
5969     if {$rl1 < $r} {
5970         layoutrows $rl1 $r
5971     }
5972     optimize_rows $ro1 0 $r2
5973     if {$need_redisplay || $nrows_drawn > 2000} {
5974         clear_display
5975     }
5976
5977     # make the lines join to already-drawn rows either side
5978     set r [expr {$row - 1}]
5979     if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
5980         set r $row
5981     }
5982     set er [expr {$endrow + 1}]
5983     if {$er >= $numcommits ||
5984         ![info exists iddrawn([lindex $displayorder $er])]} {
5985         set er $endrow
5986     }
5987     for {} {$r <= $er} {incr r} {
5988         set id [lindex $displayorder $r]
5989         set wasdrawn [info exists iddrawn($id)]
5990         drawcmitrow $r
5991         if {$r == $er} break
5992         set nextid [lindex $displayorder [expr {$r + 1}]]
5993         if {$wasdrawn && [info exists iddrawn($nextid)]} continue
5994         drawparentlinks $id $r
5995
5996         set rowids [lindex $rowidlist $r]
5997         foreach lid $rowids {
5998             if {$lid eq {}} continue
5999             if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
6000             if {$lid eq $id} {
6001                 # see if this is the first child of any of its parents
6002                 foreach p [lindex $parentlist $r] {
6003                     if {[lsearch -exact $rowids $p] < 0} {
6004                         # make this line extend up to the child
6005                         set lineend($p) [drawlineseg $p $r $er 0]
6006                     }
6007                 }
6008             } else {
6009                 set lineend($lid) [drawlineseg $lid $r $er 1]
6010             }
6011         }
6012     }
6013 }
6014
6015 proc undolayout {row} {
6016     global uparrowlen mingaplen downarrowlen
6017     global rowidlist rowisopt rowfinal need_redisplay
6018
6019     set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
6020     if {$r < 0} {
6021         set r 0
6022     }
6023     if {[llength $rowidlist] > $r} {
6024         incr r -1
6025         set rowidlist [lrange $rowidlist 0 $r]
6026         set rowfinal [lrange $rowfinal 0 $r]
6027         set rowisopt [lrange $rowisopt 0 $r]
6028         set need_redisplay 1
6029         run drawvisible
6030     }
6031 }
6032
6033 proc drawvisible {} {
6034     global canv linespc curview vrowmod selectedline targetrow targetid
6035     global need_redisplay cscroll numcommits
6036
6037     set fs [$canv yview]
6038     set ymax [lindex [$canv cget -scrollregion] 3]
6039     if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
6040     set f0 [lindex $fs 0]
6041     set f1 [lindex $fs 1]
6042     set y0 [expr {int($f0 * $ymax)}]
6043     set y1 [expr {int($f1 * $ymax)}]
6044
6045     if {[info exists targetid]} {
6046         if {[commitinview $targetid $curview]} {
6047             set r [rowofcommit $targetid]
6048             if {$r != $targetrow} {
6049                 # Fix up the scrollregion and change the scrolling position
6050                 # now that our target row has moved.
6051                 set diff [expr {($r - $targetrow) * $linespc}]
6052                 set targetrow $r
6053                 setcanvscroll
6054                 set ymax [lindex [$canv cget -scrollregion] 3]
6055                 incr y0 $diff
6056                 incr y1 $diff
6057                 set f0 [expr {$y0 / $ymax}]
6058                 set f1 [expr {$y1 / $ymax}]
6059                 allcanvs yview moveto $f0
6060                 $cscroll set $f0 $f1
6061                 set need_redisplay 1
6062             }
6063         } else {
6064             unset targetid
6065         }
6066     }
6067
6068     set row [expr {int(($y0 - 3) / $linespc) - 1}]
6069     set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
6070     if {$endrow >= $vrowmod($curview)} {
6071         update_arcrows $curview
6072     }
6073     if {$selectedline ne {} &&
6074         $row <= $selectedline && $selectedline <= $endrow} {
6075         set targetrow $selectedline
6076     } elseif {[info exists targetid]} {
6077         set targetrow [expr {int(($row + $endrow) / 2)}]
6078     }
6079     if {[info exists targetrow]} {
6080         if {$targetrow >= $numcommits} {
6081             set targetrow [expr {$numcommits - 1}]
6082         }
6083         set targetid [commitonrow $targetrow]
6084     }
6085     drawcommits $row $endrow
6086 }
6087
6088 proc clear_display {} {
6089     global iddrawn linesegs need_redisplay nrows_drawn
6090     global vhighlights fhighlights nhighlights rhighlights
6091     global linehtag linentag linedtag boldids boldnameids
6092
6093     allcanvs delete all
6094     catch {unset iddrawn}
6095     catch {unset linesegs}
6096     catch {unset linehtag}
6097     catch {unset linentag}
6098     catch {unset linedtag}
6099     set boldids {}
6100     set boldnameids {}
6101     catch {unset vhighlights}
6102     catch {unset fhighlights}
6103     catch {unset nhighlights}
6104     catch {unset rhighlights}
6105     set need_redisplay 0
6106     set nrows_drawn 0
6107 }
6108
6109 proc findcrossings {id} {
6110     global rowidlist parentlist numcommits displayorder
6111
6112     set cross {}
6113     set ccross {}
6114     foreach {s e} [rowranges $id] {
6115         if {$e >= $numcommits} {
6116             set e [expr {$numcommits - 1}]
6117         }
6118         if {$e <= $s} continue
6119         for {set row $e} {[incr row -1] >= $s} {} {
6120             set x [lsearch -exact [lindex $rowidlist $row] $id]
6121             if {$x < 0} break
6122             set olds [lindex $parentlist $row]
6123             set kid [lindex $displayorder $row]
6124             set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
6125             if {$kidx < 0} continue
6126             set nextrow [lindex $rowidlist [expr {$row + 1}]]
6127             foreach p $olds {
6128                 set px [lsearch -exact $nextrow $p]
6129                 if {$px < 0} continue
6130                 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
6131                     if {[lsearch -exact $ccross $p] >= 0} continue
6132                     if {$x == $px + ($kidx < $px? -1: 1)} {
6133                         lappend ccross $p
6134                     } elseif {[lsearch -exact $cross $p] < 0} {
6135                         lappend cross $p
6136                     }
6137                 }
6138             }
6139         }
6140     }
6141     return [concat $ccross {{}} $cross]
6142 }
6143
6144 proc assigncolor {id} {
6145     global colormap colors nextcolor
6146     global parents children children curview
6147
6148     if {[info exists colormap($id)]} return
6149     set ncolors [llength $colors]
6150     if {[info exists children($curview,$id)]} {
6151         set kids $children($curview,$id)
6152     } else {
6153         set kids {}
6154     }
6155     if {[llength $kids] == 1} {
6156         set child [lindex $kids 0]
6157         if {[info exists colormap($child)]
6158             && [llength $parents($curview,$child)] == 1} {
6159             set colormap($id) $colormap($child)
6160             return
6161         }
6162     }
6163     set badcolors {}
6164     set origbad {}
6165     foreach x [findcrossings $id] {
6166         if {$x eq {}} {
6167             # delimiter between corner crossings and other crossings
6168             if {[llength $badcolors] >= $ncolors - 1} break
6169             set origbad $badcolors
6170         }
6171         if {[info exists colormap($x)]
6172             && [lsearch -exact $badcolors $colormap($x)] < 0} {
6173             lappend badcolors $colormap($x)
6174         }
6175     }
6176     if {[llength $badcolors] >= $ncolors} {
6177         set badcolors $origbad
6178     }
6179     set origbad $badcolors
6180     if {[llength $badcolors] < $ncolors - 1} {
6181         foreach child $kids {
6182             if {[info exists colormap($child)]
6183                 && [lsearch -exact $badcolors $colormap($child)] < 0} {
6184                 lappend badcolors $colormap($child)
6185             }
6186             foreach p $parents($curview,$child) {
6187                 if {[info exists colormap($p)]
6188                     && [lsearch -exact $badcolors $colormap($p)] < 0} {
6189                     lappend badcolors $colormap($p)
6190                 }
6191             }
6192         }
6193         if {[llength $badcolors] >= $ncolors} {
6194             set badcolors $origbad
6195         }
6196     }
6197     for {set i 0} {$i <= $ncolors} {incr i} {
6198         set c [lindex $colors $nextcolor]
6199         if {[incr nextcolor] >= $ncolors} {
6200             set nextcolor 0
6201         }
6202         if {[lsearch -exact $badcolors $c]} break
6203     }
6204     set colormap($id) $c
6205 }
6206
6207 proc bindline {t id} {
6208     global canv
6209
6210     $canv bind $t <Enter> "lineenter %x %y $id"
6211     $canv bind $t <Motion> "linemotion %x %y $id"
6212     $canv bind $t <Leave> "lineleave $id"
6213     $canv bind $t <Button-1> "lineclick %x %y $id 1"
6214 }
6215
6216 proc drawtags {id x xt y1} {
6217     global idtags idheads idotherrefs mainhead
6218     global linespc lthickness
6219     global canv rowtextx curview fgcolor bgcolor ctxbut
6220
6221     set marks {}
6222     set ntags 0
6223     set nheads 0
6224     if {[info exists idtags($id)]} {
6225         set marks $idtags($id)
6226         set ntags [llength $marks]
6227     }
6228     if {[info exists idheads($id)]} {
6229         set marks [concat $marks $idheads($id)]
6230         set nheads [llength $idheads($id)]
6231     }
6232     if {[info exists idotherrefs($id)]} {
6233         set marks [concat $marks $idotherrefs($id)]
6234     }
6235     if {$marks eq {}} {
6236         return $xt
6237     }
6238
6239     set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6240     set yt [expr {$y1 - 0.5 * $linespc}]
6241     set yb [expr {$yt + $linespc - 1}]
6242     set xvals {}
6243     set wvals {}
6244     set i -1
6245     foreach tag $marks {
6246         incr i
6247         if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
6248             set wid [font measure mainfontbold $tag]
6249         } else {
6250             set wid [font measure mainfont $tag]
6251         }
6252         lappend xvals $xt
6253         lappend wvals $wid
6254         set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
6255     }
6256     set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
6257                -width $lthickness -fill black -tags tag.$id]
6258     $canv lower $t
6259     foreach tag $marks x $xvals wid $wvals {
6260         set xl [expr {$x + $delta}]
6261         set xr [expr {$x + $delta + $wid + $lthickness}]
6262         set font mainfont
6263         if {[incr ntags -1] >= 0} {
6264             # draw a tag
6265             set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6266                        $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
6267                        -width 1 -outline black -fill yellow -tags tag.$id]
6268             $canv bind $t <1> [list showtag $tag 1]
6269             set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
6270         } else {
6271             # draw a head or other ref
6272             if {[incr nheads -1] >= 0} {
6273                 set col green
6274                 if {$tag eq $mainhead} {
6275                     set font mainfontbold
6276                 }
6277             } else {
6278                 set col "#ddddff"
6279             }
6280             set xl [expr {$xl - $delta/2}]
6281             $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
6282                 -width 1 -outline black -fill $col -tags tag.$id
6283             if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
6284                 set rwid [font measure mainfont $remoteprefix]
6285                 set xi [expr {$x + 1}]
6286                 set yti [expr {$yt + 1}]
6287                 set xri [expr {$x + $rwid}]
6288                 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6289                         -width 0 -fill "#ffddaa" -tags tag.$id
6290             }
6291         }
6292         set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
6293                    -font $font -tags [list tag.$id text]]
6294         if {$ntags >= 0} {
6295             $canv bind $t <1> [list showtag $tag 1]
6296         } elseif {$nheads >= 0} {
6297             $canv bind $t $ctxbut [list headmenu %X %Y $id $tag]
6298         }
6299     }
6300     return $xt
6301 }
6302
6303 proc xcoord {i level ln} {
6304     global canvx0 xspc1 xspc2
6305
6306     set x [expr {$canvx0 + $i * $xspc1($ln)}]
6307     if {$i > 0 && $i == $level} {
6308         set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6309     } elseif {$i > $level} {
6310         set x [expr {$x + $xspc2 - $xspc1($ln)}]
6311     }
6312     return $x
6313 }
6314
6315 proc show_status {msg} {
6316     global canv fgcolor
6317
6318     clear_display
6319     $canv create text 3 3 -anchor nw -text $msg -font mainfont \
6320         -tags text -fill $fgcolor
6321 }
6322
6323 # Don't change the text pane cursor if it is currently the hand cursor,
6324 # showing that we are over a sha1 ID link.
6325 proc settextcursor {c} {
6326     global ctext curtextcursor
6327
6328     if {[$ctext cget -cursor] == $curtextcursor} {
6329         $ctext config -cursor $c
6330     }
6331     set curtextcursor $c
6332 }
6333
6334 proc nowbusy {what {name {}}} {
6335     global isbusy busyname statusw
6336
6337     if {[array names isbusy] eq {}} {
6338         . config -cursor watch
6339         settextcursor watch
6340     }
6341     set isbusy($what) 1
6342     set busyname($what) $name
6343     if {$name ne {}} {
6344         $statusw conf -text $name
6345     }
6346 }
6347
6348 proc notbusy {what} {
6349     global isbusy maincursor textcursor busyname statusw
6350
6351     catch {
6352         unset isbusy($what)
6353         if {$busyname($what) ne {} &&
6354             [$statusw cget -text] eq $busyname($what)} {
6355             $statusw conf -text {}
6356         }
6357     }
6358     if {[array names isbusy] eq {}} {
6359         . config -cursor $maincursor
6360         settextcursor $textcursor
6361     }
6362 }
6363
6364 proc findmatches {f} {
6365     global findtype findstring
6366     if {$findtype == [mc "Regexp"]} {
6367         set matches [regexp -indices -all -inline $findstring $f]
6368     } else {
6369         set fs $findstring
6370         if {$findtype == [mc "IgnCase"]} {
6371             set f [string tolower $f]
6372             set fs [string tolower $fs]
6373         }
6374         set matches {}
6375         set i 0
6376         set l [string length $fs]
6377         while {[set j [string first $fs $f $i]] >= 0} {
6378             lappend matches [list $j [expr {$j+$l-1}]]
6379             set i [expr {$j + $l}]
6380         }
6381     }
6382     return $matches
6383 }
6384
6385 proc dofind {{dirn 1} {wrap 1}} {
6386     global findstring findstartline findcurline selectedline numcommits
6387     global gdttype filehighlight fh_serial find_dirn findallowwrap
6388
6389     if {[info exists find_dirn]} {
6390         if {$find_dirn == $dirn} return
6391         stopfinding
6392     }
6393     focus .
6394     if {$findstring eq {} || $numcommits == 0} return
6395     if {$selectedline eq {}} {
6396         set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6397     } else {
6398         set findstartline $selectedline
6399     }
6400     set findcurline $findstartline
6401     nowbusy finding [mc "Searching"]
6402     if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6403         after cancel do_file_hl $fh_serial
6404         do_file_hl $fh_serial
6405     }
6406     set find_dirn $dirn
6407     set findallowwrap $wrap
6408     run findmore
6409 }
6410
6411 proc stopfinding {} {
6412     global find_dirn findcurline fprogcoord
6413
6414     if {[info exists find_dirn]} {
6415         unset find_dirn
6416         unset findcurline
6417         notbusy finding
6418         set fprogcoord 0
6419         adjustprogress
6420     }
6421     stopblaming
6422 }
6423
6424 proc findmore {} {
6425     global commitdata commitinfo numcommits findpattern findloc
6426     global findstartline findcurline findallowwrap
6427     global find_dirn gdttype fhighlights fprogcoord
6428     global curview varcorder vrownum varccommits vrowmod
6429
6430     if {![info exists find_dirn]} {
6431         return 0
6432     }
6433     set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
6434     set l $findcurline
6435     set moretodo 0
6436     if {$find_dirn > 0} {
6437         incr l
6438         if {$l >= $numcommits} {
6439             set l 0
6440         }
6441         if {$l <= $findstartline} {
6442             set lim [expr {$findstartline + 1}]
6443         } else {
6444             set lim $numcommits
6445             set moretodo $findallowwrap
6446         }
6447     } else {
6448         if {$l == 0} {
6449             set l $numcommits
6450         }
6451         incr l -1
6452         if {$l >= $findstartline} {
6453             set lim [expr {$findstartline - 1}]
6454         } else {
6455             set lim -1
6456             set moretodo $findallowwrap
6457         }
6458     }
6459     set n [expr {($lim - $l) * $find_dirn}]
6460     if {$n > 500} {
6461         set n 500
6462         set moretodo 1
6463     }
6464     if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6465         update_arcrows $curview
6466     }
6467     set found 0
6468     set domore 1
6469     set ai [bsearch $vrownum($curview) $l]
6470     set a [lindex $varcorder($curview) $ai]
6471     set arow [lindex $vrownum($curview) $ai]
6472     set ids [lindex $varccommits($curview,$a)]
6473     set arowend [expr {$arow + [llength $ids]}]
6474     if {$gdttype eq [mc "containing:"]} {
6475         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6476             if {$l < $arow || $l >= $arowend} {
6477                 incr ai $find_dirn
6478                 set a [lindex $varcorder($curview) $ai]
6479                 set arow [lindex $vrownum($curview) $ai]
6480                 set ids [lindex $varccommits($curview,$a)]
6481                 set arowend [expr {$arow + [llength $ids]}]
6482             }
6483             set id [lindex $ids [expr {$l - $arow}]]
6484             # shouldn't happen unless git log doesn't give all the commits...
6485             if {![info exists commitdata($id)] ||
6486                 ![doesmatch $commitdata($id)]} {
6487                 continue
6488             }
6489             if {![info exists commitinfo($id)]} {
6490                 getcommit $id
6491             }
6492             set info $commitinfo($id)
6493             foreach f $info ty $fldtypes {
6494                 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6495                     [doesmatch $f]} {
6496                     set found 1
6497                     break
6498                 }
6499             }
6500             if {$found} break
6501         }
6502     } else {
6503         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6504             if {$l < $arow || $l >= $arowend} {
6505                 incr ai $find_dirn
6506                 set a [lindex $varcorder($curview) $ai]
6507                 set arow [lindex $vrownum($curview) $ai]
6508                 set ids [lindex $varccommits($curview,$a)]
6509                 set arowend [expr {$arow + [llength $ids]}]
6510             }
6511             set id [lindex $ids [expr {$l - $arow}]]
6512             if {![info exists fhighlights($id)]} {
6513                 # this sets fhighlights($id) to -1
6514                 askfilehighlight $l $id
6515             }
6516             if {$fhighlights($id) > 0} {
6517                 set found $domore
6518                 break
6519             }
6520             if {$fhighlights($id) < 0} {
6521                 if {$domore} {
6522                     set domore 0
6523                     set findcurline [expr {$l - $find_dirn}]
6524                 }
6525             }
6526         }
6527     }
6528     if {$found || ($domore && !$moretodo)} {
6529         unset findcurline
6530         unset find_dirn
6531         notbusy finding
6532         set fprogcoord 0
6533         adjustprogress
6534         if {$found} {
6535             findselectline $l
6536         } else {
6537             bell
6538         }
6539         return 0
6540     }
6541     if {!$domore} {
6542         flushhighlights
6543     } else {
6544         set findcurline [expr {$l - $find_dirn}]
6545     }
6546     set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6547     if {$n < 0} {
6548         incr n $numcommits
6549     }
6550     set fprogcoord [expr {$n * 1.0 / $numcommits}]
6551     adjustprogress
6552     return $domore
6553 }
6554
6555 proc findselectline {l} {
6556     global findloc commentend ctext findcurline markingmatches gdttype
6557
6558     set markingmatches [expr {$gdttype eq [mc "containing:"]}]
6559     set findcurline $l
6560     selectline $l 1
6561     if {$markingmatches &&
6562         ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
6563         # highlight the matches in the comments
6564         set f [$ctext get 1.0 $commentend]
6565         set matches [findmatches $f]
6566         foreach match $matches {
6567             set start [lindex $match 0]
6568             set end [expr {[lindex $match 1] + 1}]
6569             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6570         }
6571     }
6572     drawvisible
6573 }
6574
6575 # mark the bits of a headline or author that match a find string
6576 proc markmatches {canv l str tag matches font row} {
6577     global selectedline
6578
6579     set bbox [$canv bbox $tag]
6580     set x0 [lindex $bbox 0]
6581     set y0 [lindex $bbox 1]
6582     set y1 [lindex $bbox 3]
6583     foreach match $matches {
6584         set start [lindex $match 0]
6585         set end [lindex $match 1]
6586         if {$start > $end} continue
6587         set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6588         set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6589         set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6590                    [expr {$x0+$xlen+2}] $y1 \
6591                    -outline {} -tags [list match$l matches] -fill yellow]
6592         $canv lower $t
6593         if {$row == $selectedline} {
6594             $canv raise $t secsel
6595         }
6596     }
6597 }
6598
6599 proc unmarkmatches {} {
6600     global markingmatches
6601
6602     allcanvs delete matches
6603     set markingmatches 0
6604     stopfinding
6605 }
6606
6607 proc selcanvline {w x y} {
6608     global canv canvy0 ctext linespc
6609     global rowtextx
6610     set ymax [lindex [$canv cget -scrollregion] 3]
6611     if {$ymax == {}} return
6612     set yfrac [lindex [$canv yview] 0]
6613     set y [expr {$y + $yfrac * $ymax}]
6614     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6615     if {$l < 0} {
6616         set l 0
6617     }
6618     if {$w eq $canv} {
6619         set xmax [lindex [$canv cget -scrollregion] 2]
6620         set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6621         if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
6622     }
6623     unmarkmatches
6624     selectline $l 1
6625 }
6626
6627 proc commit_descriptor {p} {
6628     global commitinfo
6629     if {![info exists commitinfo($p)]} {
6630         getcommit $p
6631     }
6632     set l "..."
6633     if {[llength $commitinfo($p)] > 1} {
6634         set l [lindex $commitinfo($p) 0]
6635     }
6636     return "$p ($l)\n"
6637 }
6638
6639 # append some text to the ctext widget, and make any SHA1 ID
6640 # that we know about be a clickable link.
6641 proc appendwithlinks {text tags} {
6642     global ctext linknum curview
6643
6644     set start [$ctext index "end - 1c"]
6645     $ctext insert end $text $tags
6646     set links [regexp -indices -all -inline {\m[0-9a-f]{6,40}\M} $text]
6647     foreach l $links {
6648         set s [lindex $l 0]
6649         set e [lindex $l 1]
6650         set linkid [string range $text $s $e]
6651         incr e
6652         $ctext tag delete link$linknum
6653         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
6654         setlink $linkid link$linknum
6655         incr linknum
6656     }
6657 }
6658
6659 proc setlink {id lk} {
6660     global curview ctext pendinglinks
6661
6662     set known 0
6663     if {[string length $id] < 40} {
6664         set matches [longid $id]
6665         if {[llength $matches] > 0} {
6666             if {[llength $matches] > 1} return
6667             set known 1
6668             set id [lindex $matches 0]
6669         }
6670     } else {
6671         set known [commitinview $id $curview]
6672     }
6673     if {$known} {
6674         $ctext tag conf $lk -foreground blue -underline 1
6675         $ctext tag bind $lk <1> [list selbyid $id]
6676         $ctext tag bind $lk <Enter> {linkcursor %W 1}
6677         $ctext tag bind $lk <Leave> {linkcursor %W -1}
6678     } else {
6679         lappend pendinglinks($id) $lk
6680         interestedin $id {makelink %P}
6681     }
6682 }
6683
6684 proc appendshortlink {id {pre {}} {post {}}} {
6685     global ctext linknum
6686
6687     $ctext insert end $pre
6688     $ctext tag delete link$linknum
6689     $ctext insert end [string range $id 0 7] link$linknum
6690     $ctext insert end $post
6691     setlink $id link$linknum
6692     incr linknum
6693 }
6694
6695 proc makelink {id} {
6696     global pendinglinks
6697
6698     if {![info exists pendinglinks($id)]} return
6699     foreach lk $pendinglinks($id) {
6700         setlink $id $lk
6701     }
6702     unset pendinglinks($id)
6703 }
6704
6705 proc linkcursor {w inc} {
6706     global linkentercount curtextcursor
6707
6708     if {[incr linkentercount $inc] > 0} {
6709         $w configure -cursor hand2
6710     } else {
6711         $w configure -cursor $curtextcursor
6712         if {$linkentercount < 0} {
6713             set linkentercount 0
6714         }
6715     }
6716 }
6717
6718 proc viewnextline {dir} {
6719     global canv linespc
6720
6721     $canv delete hover
6722     set ymax [lindex [$canv cget -scrollregion] 3]
6723     set wnow [$canv yview]
6724     set wtop [expr {[lindex $wnow 0] * $ymax}]
6725     set newtop [expr {$wtop + $dir * $linespc}]
6726     if {$newtop < 0} {
6727         set newtop 0
6728     } elseif {$newtop > $ymax} {
6729         set newtop $ymax
6730     }
6731     allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6732 }
6733
6734 # add a list of tag or branch names at position pos
6735 # returns the number of names inserted
6736 proc appendrefs {pos ids var} {
6737     global ctext linknum curview $var maxrefs
6738
6739     if {[catch {$ctext index $pos}]} {
6740         return 0
6741     }
6742     $ctext conf -state normal
6743     $ctext delete $pos "$pos lineend"
6744     set tags {}
6745     foreach id $ids {
6746         foreach tag [set $var\($id\)] {
6747             lappend tags [list $tag $id]
6748         }
6749     }
6750     if {[llength $tags] > $maxrefs} {
6751         $ctext insert $pos "[mc "many"] ([llength $tags])"
6752     } else {
6753         set tags [lsort -index 0 -decreasing $tags]
6754         set sep {}
6755         foreach ti $tags {
6756             set id [lindex $ti 1]
6757             set lk link$linknum
6758             incr linknum
6759             $ctext tag delete $lk
6760             $ctext insert $pos $sep
6761             $ctext insert $pos [lindex $ti 0] $lk
6762             setlink $id $lk
6763             set sep ", "
6764         }
6765     }
6766     $ctext conf -state disabled
6767     return [llength $tags]
6768 }
6769
6770 # called when we have finished computing the nearby tags
6771 proc dispneartags {delay} {
6772     global selectedline currentid showneartags tagphase
6773
6774     if {$selectedline eq {} || !$showneartags} return
6775     after cancel dispnexttag
6776     if {$delay} {
6777         after 200 dispnexttag
6778         set tagphase -1
6779     } else {
6780         after idle dispnexttag
6781         set tagphase 0
6782     }
6783 }
6784
6785 proc dispnexttag {} {
6786     global selectedline currentid showneartags tagphase ctext
6787
6788     if {$selectedline eq {} || !$showneartags} return
6789     switch -- $tagphase {
6790         0 {
6791             set dtags [desctags $currentid]
6792             if {$dtags ne {}} {
6793                 appendrefs precedes $dtags idtags
6794             }
6795         }
6796         1 {
6797             set atags [anctags $currentid]
6798             if {$atags ne {}} {
6799                 appendrefs follows $atags idtags
6800             }
6801         }
6802         2 {
6803             set dheads [descheads $currentid]
6804             if {$dheads ne {}} {
6805                 if {[appendrefs branch $dheads idheads] > 1
6806                     && [$ctext get "branch -3c"] eq "h"} {
6807                     # turn "Branch" into "Branches"
6808                     $ctext conf -state normal
6809                     $ctext insert "branch -2c" "es"
6810                     $ctext conf -state disabled
6811                 }
6812             }
6813         }
6814     }
6815     if {[incr tagphase] <= 2} {
6816         after idle dispnexttag
6817     }
6818 }
6819
6820 proc make_secsel {id} {
6821     global linehtag linentag linedtag canv canv2 canv3
6822
6823     if {![info exists linehtag($id)]} return
6824     $canv delete secsel
6825     set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
6826                -tags secsel -fill [$canv cget -selectbackground]]
6827     $canv lower $t
6828     $canv2 delete secsel
6829     set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
6830                -tags secsel -fill [$canv2 cget -selectbackground]]
6831     $canv2 lower $t
6832     $canv3 delete secsel
6833     set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
6834                -tags secsel -fill [$canv3 cget -selectbackground]]
6835     $canv3 lower $t
6836 }
6837
6838 proc make_idmark {id} {
6839     global linehtag canv fgcolor
6840
6841     if {![info exists linehtag($id)]} return
6842     $canv delete markid
6843     set t [eval $canv create rect [$canv bbox $linehtag($id)] \
6844                -tags markid -outline $fgcolor]
6845     $canv raise $t
6846 }
6847
6848 proc selectline {l isnew {desired_loc {}}} {
6849     global canv ctext commitinfo selectedline
6850     global canvy0 linespc parents children curview
6851     global currentid sha1entry
6852     global commentend idtags linknum
6853     global mergemax numcommits pending_select
6854     global cmitmode showneartags allcommits
6855     global targetrow targetid lastscrollrows
6856     global autoselect jump_to_here
6857
6858     catch {unset pending_select}
6859     $canv delete hover
6860     normalline
6861     unsel_reflist
6862     stopfinding
6863     if {$l < 0 || $l >= $numcommits} return
6864     set id [commitonrow $l]
6865     set targetid $id
6866     set targetrow $l
6867     set selectedline $l
6868     set currentid $id
6869     if {$lastscrollrows < $numcommits} {
6870         setcanvscroll
6871     }
6872
6873     set y [expr {$canvy0 + $l * $linespc}]
6874     set ymax [lindex [$canv cget -scrollregion] 3]
6875     set ytop [expr {$y - $linespc - 1}]
6876     set ybot [expr {$y + $linespc + 1}]
6877     set wnow [$canv yview]
6878     set wtop [expr {[lindex $wnow 0] * $ymax}]
6879     set wbot [expr {[lindex $wnow 1] * $ymax}]
6880     set wh [expr {$wbot - $wtop}]
6881     set newtop $wtop
6882     if {$ytop < $wtop} {
6883         if {$ybot < $wtop} {
6884             set newtop [expr {$y - $wh / 2.0}]
6885         } else {
6886             set newtop $ytop
6887             if {$newtop > $wtop - $linespc} {
6888                 set newtop [expr {$wtop - $linespc}]
6889             }
6890         }
6891     } elseif {$ybot > $wbot} {
6892         if {$ytop > $wbot} {
6893             set newtop [expr {$y - $wh / 2.0}]
6894         } else {
6895             set newtop [expr {$ybot - $wh}]
6896             if {$newtop < $wtop + $linespc} {
6897                 set newtop [expr {$wtop + $linespc}]
6898             }
6899         }
6900     }
6901     if {$newtop != $wtop} {
6902         if {$newtop < 0} {
6903             set newtop 0
6904         }
6905         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6906         drawvisible
6907     }
6908
6909     make_secsel $id
6910
6911     if {$isnew} {
6912         addtohistory [list selbyid $id 0] savecmitpos
6913     }
6914
6915     $sha1entry delete 0 end
6916     $sha1entry insert 0 $id
6917     if {$autoselect} {
6918         $sha1entry selection range 0 end
6919     }
6920     rhighlight_sel $id
6921
6922     $ctext conf -state normal
6923     clear_ctext
6924     set linknum 0
6925     if {![info exists commitinfo($id)]} {
6926         getcommit $id
6927     }
6928     set info $commitinfo($id)
6929     set date [formatdate [lindex $info 2]]
6930     $ctext insert end "[mc "Author"]: [lindex $info 1]  $date\n"
6931     set date [formatdate [lindex $info 4]]
6932     $ctext insert end "[mc "Committer"]: [lindex $info 3]  $date\n"
6933     if {[info exists idtags($id)]} {
6934         $ctext insert end [mc "Tags:"]
6935         foreach tag $idtags($id) {
6936             $ctext insert end " $tag"
6937         }
6938         $ctext insert end "\n"
6939     }
6940
6941     set headers {}
6942     set olds $parents($curview,$id)
6943     if {[llength $olds] > 1} {
6944         set np 0
6945         foreach p $olds {
6946             if {$np >= $mergemax} {
6947                 set tag mmax
6948             } else {
6949                 set tag m$np
6950             }
6951             $ctext insert end "[mc "Parent"]: " $tag
6952             appendwithlinks [commit_descriptor $p] {}
6953             incr np
6954         }
6955     } else {
6956         foreach p $olds {
6957             append headers "[mc "Parent"]: [commit_descriptor $p]"
6958         }
6959     }
6960
6961     foreach c $children($curview,$id) {
6962         append headers "[mc "Child"]:  [commit_descriptor $c]"
6963     }
6964
6965     # make anything that looks like a SHA1 ID be a clickable link
6966     appendwithlinks $headers {}
6967     if {$showneartags} {
6968         if {![info exists allcommits]} {
6969             getallcommits
6970         }
6971         $ctext insert end "[mc "Branch"]: "
6972         $ctext mark set branch "end -1c"
6973         $ctext mark gravity branch left
6974         $ctext insert end "\n[mc "Follows"]: "
6975         $ctext mark set follows "end -1c"
6976         $ctext mark gravity follows left
6977         $ctext insert end "\n[mc "Precedes"]: "
6978         $ctext mark set precedes "end -1c"
6979         $ctext mark gravity precedes left
6980         $ctext insert end "\n"
6981         dispneartags 1
6982     }
6983     $ctext insert end "\n"
6984     set comment [lindex $info 5]
6985     if {[string first "\r" $comment] >= 0} {
6986         set comment [string map {"\r" "\n    "} $comment]
6987     }
6988     appendwithlinks $comment {comment}
6989
6990     $ctext tag remove found 1.0 end
6991     $ctext conf -state disabled
6992     set commentend [$ctext index "end - 1c"]
6993
6994     set jump_to_here $desired_loc
6995     init_flist [mc "Comments"]
6996     if {$cmitmode eq "tree"} {
6997         gettree $id
6998     } elseif {[llength $olds] <= 1} {
6999         startdiff $id
7000     } else {
7001         mergediff $id
7002     }
7003 }
7004
7005 proc selfirstline {} {
7006     unmarkmatches
7007     selectline 0 1
7008 }
7009
7010 proc sellastline {} {
7011     global numcommits
7012     unmarkmatches
7013     set l [expr {$numcommits - 1}]
7014     selectline $l 1
7015 }
7016
7017 proc selnextline {dir} {
7018     global selectedline
7019     focus .
7020     if {$selectedline eq {}} return
7021     set l [expr {$selectedline + $dir}]
7022     unmarkmatches
7023     selectline $l 1
7024 }
7025
7026 proc selnextpage {dir} {
7027     global canv linespc selectedline numcommits
7028
7029     set lpp [expr {([winfo height $canv] - 2) / $linespc}]
7030     if {$lpp < 1} {
7031         set lpp 1
7032     }
7033     allcanvs yview scroll [expr {$dir * $lpp}] units
7034     drawvisible
7035     if {$selectedline eq {}} return
7036     set l [expr {$selectedline + $dir * $lpp}]
7037     if {$l < 0} {
7038         set l 0
7039     } elseif {$l >= $numcommits} {
7040         set l [expr $numcommits - 1]
7041     }
7042     unmarkmatches
7043     selectline $l 1
7044 }
7045
7046 proc unselectline {} {
7047     global selectedline currentid
7048
7049     set selectedline {}
7050     catch {unset currentid}
7051     allcanvs delete secsel
7052     rhighlight_none
7053 }
7054
7055 proc reselectline {} {
7056     global selectedline
7057
7058     if {$selectedline ne {}} {
7059         selectline $selectedline 0
7060     }
7061 }
7062
7063 proc addtohistory {cmd {saveproc {}}} {
7064     global history historyindex curview
7065
7066     unset_posvars
7067     save_position
7068     set elt [list $curview $cmd $saveproc {}]
7069     if {$historyindex > 0
7070         && [lindex $history [expr {$historyindex - 1}]] == $elt} {
7071         return
7072     }
7073
7074     if {$historyindex < [llength $history]} {
7075         set history [lreplace $history $historyindex end $elt]
7076     } else {
7077         lappend history $elt
7078     }
7079     incr historyindex
7080     if {$historyindex > 1} {
7081         .tf.bar.leftbut conf -state normal
7082     } else {
7083         .tf.bar.leftbut conf -state disabled
7084     }
7085     .tf.bar.rightbut conf -state disabled
7086 }
7087
7088 # save the scrolling position of the diff display pane
7089 proc save_position {} {
7090     global historyindex history
7091
7092     if {$historyindex < 1} return
7093     set hi [expr {$historyindex - 1}]
7094     set fn [lindex $history $hi 2]
7095     if {$fn ne {}} {
7096         lset history $hi 3 [eval $fn]
7097     }
7098 }
7099
7100 proc unset_posvars {} {
7101     global last_posvars
7102
7103     if {[info exists last_posvars]} {
7104         foreach {var val} $last_posvars {
7105             global $var
7106             catch {unset $var}
7107         }
7108         unset last_posvars
7109     }
7110 }
7111
7112 proc godo {elt} {
7113     global curview last_posvars
7114
7115     set view [lindex $elt 0]
7116     set cmd [lindex $elt 1]
7117     set pv [lindex $elt 3]
7118     if {$curview != $view} {
7119         showview $view
7120     }
7121     unset_posvars
7122     foreach {var val} $pv {
7123         global $var
7124         set $var $val
7125     }
7126     set last_posvars $pv
7127     eval $cmd
7128 }
7129
7130 proc goback {} {
7131     global history historyindex
7132     focus .
7133
7134     if {$historyindex > 1} {
7135         save_position
7136         incr historyindex -1
7137         godo [lindex $history [expr {$historyindex - 1}]]
7138         .tf.bar.rightbut conf -state normal
7139     }
7140     if {$historyindex <= 1} {
7141         .tf.bar.leftbut conf -state disabled
7142     }
7143 }
7144
7145 proc goforw {} {
7146     global history historyindex
7147     focus .
7148
7149     if {$historyindex < [llength $history]} {
7150         save_position
7151         set cmd [lindex $history $historyindex]
7152         incr historyindex
7153         godo $cmd
7154         .tf.bar.leftbut conf -state normal
7155     }
7156     if {$historyindex >= [llength $history]} {
7157         .tf.bar.rightbut conf -state disabled
7158     }
7159 }
7160
7161 proc gettree {id} {
7162     global treefilelist treeidlist diffids diffmergeid treepending
7163     global nullid nullid2
7164
7165     set diffids $id
7166     catch {unset diffmergeid}
7167     if {![info exists treefilelist($id)]} {
7168         if {![info exists treepending]} {
7169             if {$id eq $nullid} {
7170                 set cmd [list | git ls-files]
7171             } elseif {$id eq $nullid2} {
7172                 set cmd [list | git ls-files --stage -t]
7173             } else {
7174                 set cmd [list | git ls-tree -r $id]
7175             }
7176             if {[catch {set gtf [open $cmd r]}]} {
7177                 return
7178             }
7179             set treepending $id
7180             set treefilelist($id) {}
7181             set treeidlist($id) {}
7182             fconfigure $gtf -blocking 0 -encoding binary
7183             filerun $gtf [list gettreeline $gtf $id]
7184         }
7185     } else {
7186         setfilelist $id
7187     }
7188 }
7189
7190 proc gettreeline {gtf id} {
7191     global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
7192
7193     set nl 0
7194     while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
7195         if {$diffids eq $nullid} {
7196             set fname $line
7197         } else {
7198             set i [string first "\t" $line]
7199             if {$i < 0} continue
7200             set fname [string range $line [expr {$i+1}] end]
7201             set line [string range $line 0 [expr {$i-1}]]
7202             if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7203             set sha1 [lindex $line 2]
7204             lappend treeidlist($id) $sha1
7205         }
7206         if {[string index $fname 0] eq "\""} {
7207             set fname [lindex $fname 0]
7208         }
7209         set fname [encoding convertfrom $fname]
7210         lappend treefilelist($id) $fname
7211     }
7212     if {![eof $gtf]} {
7213         return [expr {$nl >= 1000? 2: 1}]
7214     }
7215     close $gtf
7216     unset treepending
7217     if {$cmitmode ne "tree"} {
7218         if {![info exists diffmergeid]} {
7219             gettreediffs $diffids
7220         }
7221     } elseif {$id ne $diffids} {
7222         gettree $diffids
7223     } else {
7224         setfilelist $id
7225     }
7226     return 0
7227 }
7228
7229 proc showfile {f} {
7230     global treefilelist treeidlist diffids nullid nullid2
7231     global ctext_file_names ctext_file_lines
7232     global ctext commentend
7233
7234     set i [lsearch -exact $treefilelist($diffids) $f]
7235     if {$i < 0} {
7236         puts "oops, $f not in list for id $diffids"
7237         return
7238     }
7239     if {$diffids eq $nullid} {
7240         if {[catch {set bf [open $f r]} err]} {
7241             puts "oops, can't read $f: $err"
7242             return
7243         }
7244     } else {
7245         set blob [lindex $treeidlist($diffids) $i]
7246         if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7247             puts "oops, error reading blob $blob: $err"
7248             return
7249         }
7250     }
7251     fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7252     filerun $bf [list getblobline $bf $diffids]
7253     $ctext config -state normal
7254     clear_ctext $commentend
7255     lappend ctext_file_names $f
7256     lappend ctext_file_lines [lindex [split $commentend "."] 0]
7257     $ctext insert end "\n"
7258     $ctext insert end "$f\n" filesep
7259     $ctext config -state disabled
7260     $ctext yview $commentend
7261     settabs 0
7262 }
7263
7264 proc getblobline {bf id} {
7265     global diffids cmitmode ctext
7266
7267     if {$id ne $diffids || $cmitmode ne "tree"} {
7268         catch {close $bf}
7269         return 0
7270     }
7271     $ctext config -state normal
7272     set nl 0
7273     while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7274         $ctext insert end "$line\n"
7275     }
7276     if {[eof $bf]} {
7277         global jump_to_here ctext_file_names commentend
7278
7279         # delete last newline
7280         $ctext delete "end - 2c" "end - 1c"
7281         close $bf
7282         if {$jump_to_here ne {} &&
7283             [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7284             set lnum [expr {[lindex $jump_to_here 1] +
7285                             [lindex [split $commentend .] 0]}]
7286             mark_ctext_line $lnum
7287         }
7288         return 0
7289     }
7290     $ctext config -state disabled
7291     return [expr {$nl >= 1000? 2: 1}]
7292 }
7293
7294 proc mark_ctext_line {lnum} {
7295     global ctext markbgcolor
7296
7297     $ctext tag delete omark
7298     $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7299     $ctext tag conf omark -background $markbgcolor
7300     $ctext see $lnum.0
7301 }
7302
7303 proc mergediff {id} {
7304     global diffmergeid
7305     global diffids treediffs
7306     global parents curview
7307
7308     set diffmergeid $id
7309     set diffids $id
7310     set treediffs($id) {}
7311     set np [llength $parents($curview,$id)]
7312     settabs $np
7313     getblobdiffs $id
7314 }
7315
7316 proc startdiff {ids} {
7317     global treediffs diffids treepending diffmergeid nullid nullid2
7318
7319     settabs 1
7320     set diffids $ids
7321     catch {unset diffmergeid}
7322     if {![info exists treediffs($ids)] ||
7323         [lsearch -exact $ids $nullid] >= 0 ||
7324         [lsearch -exact $ids $nullid2] >= 0} {
7325         if {![info exists treepending]} {
7326             gettreediffs $ids
7327         }
7328     } else {
7329         addtocflist $ids
7330     }
7331 }
7332
7333 proc path_filter {filter name} {
7334     foreach p $filter {
7335         set l [string length $p]
7336         if {[string index $p end] eq "/"} {
7337             if {[string compare -length $l $p $name] == 0} {
7338                 return 1
7339             }
7340         } else {
7341             if {[string compare -length $l $p $name] == 0 &&
7342                 ([string length $name] == $l ||
7343                  [string index $name $l] eq "/")} {
7344                 return 1
7345             }
7346         }
7347     }
7348     return 0
7349 }
7350
7351 proc addtocflist {ids} {
7352     global treediffs
7353
7354     add_flist $treediffs($ids)
7355     getblobdiffs $ids
7356 }
7357
7358 proc diffcmd {ids flags} {
7359     global nullid nullid2
7360
7361     set i [lsearch -exact $ids $nullid]
7362     set j [lsearch -exact $ids $nullid2]
7363     if {$i >= 0} {
7364         if {[llength $ids] > 1 && $j < 0} {
7365             # comparing working directory with some specific revision
7366             set cmd [concat | git diff-index $flags]
7367             if {$i == 0} {
7368                 lappend cmd -R [lindex $ids 1]
7369             } else {
7370                 lappend cmd [lindex $ids 0]
7371             }
7372         } else {
7373             # comparing working directory with index
7374             set cmd [concat | git diff-files $flags]
7375             if {$j == 1} {
7376                 lappend cmd -R
7377             }
7378         }
7379     } elseif {$j >= 0} {
7380         set cmd [concat | git diff-index --cached $flags]
7381         if {[llength $ids] > 1} {
7382             # comparing index with specific revision
7383             if {$i == 0} {
7384                 lappend cmd -R [lindex $ids 1]
7385             } else {
7386                 lappend cmd [lindex $ids 0]
7387             }
7388         } else {
7389             # comparing index with HEAD
7390             lappend cmd HEAD
7391         }
7392     } else {
7393         set cmd [concat | git diff-tree -r $flags $ids]
7394     }
7395     return $cmd
7396 }
7397
7398 proc gettreediffs {ids} {
7399     global treediff treepending
7400
7401     if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
7402
7403     set treepending $ids
7404     set treediff {}
7405     fconfigure $gdtf -blocking 0 -encoding binary
7406     filerun $gdtf [list gettreediffline $gdtf $ids]
7407 }
7408
7409 proc gettreediffline {gdtf ids} {
7410     global treediff treediffs treepending diffids diffmergeid
7411     global cmitmode vfilelimit curview limitdiffs perfile_attrs
7412
7413     set nr 0
7414     set sublist {}
7415     set max 1000
7416     if {$perfile_attrs} {
7417         # cache_gitattr is slow, and even slower on win32 where we
7418         # have to invoke it for only about 30 paths at a time
7419         set max 500
7420         if {[tk windowingsystem] == "win32"} {
7421             set max 120
7422         }
7423     }
7424     while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7425         set i [string first "\t" $line]
7426         if {$i >= 0} {
7427             set file [string range $line [expr {$i+1}] end]
7428             if {[string index $file 0] eq "\""} {
7429                 set file [lindex $file 0]
7430             }
7431             set file [encoding convertfrom $file]
7432             if {$file ne [lindex $treediff end]} {
7433                 lappend treediff $file
7434                 lappend sublist $file
7435             }
7436         }
7437     }
7438     if {$perfile_attrs} {
7439         cache_gitattr encoding $sublist
7440     }
7441     if {![eof $gdtf]} {
7442         return [expr {$nr >= $max? 2: 1}]
7443     }
7444     close $gdtf
7445     if {$limitdiffs && $vfilelimit($curview) ne {}} {
7446         set flist {}
7447         foreach f $treediff {
7448             if {[path_filter $vfilelimit($curview) $f]} {
7449                 lappend flist $f
7450             }
7451         }
7452         set treediffs($ids) $flist
7453     } else {
7454         set treediffs($ids) $treediff
7455     }
7456     unset treepending
7457     if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7458         gettree $diffids
7459     } elseif {$ids != $diffids} {
7460         if {![info exists diffmergeid]} {
7461             gettreediffs $diffids
7462         }
7463     } else {
7464         addtocflist $ids
7465     }
7466     return 0
7467 }
7468
7469 # empty string or positive integer
7470 proc diffcontextvalidate {v} {
7471     return [regexp {^(|[1-9][0-9]*)$} $v]
7472 }
7473
7474 proc diffcontextchange {n1 n2 op} {
7475     global diffcontextstring diffcontext
7476
7477     if {[string is integer -strict $diffcontextstring]} {
7478         if {$diffcontextstring >= 0} {
7479             set diffcontext $diffcontextstring
7480             reselectline
7481         }
7482     }
7483 }
7484
7485 proc changeignorespace {} {
7486     reselectline
7487 }
7488
7489 proc getblobdiffs {ids} {
7490     global blobdifffd diffids env
7491     global diffinhdr treediffs
7492     global diffcontext
7493     global ignorespace
7494     global limitdiffs vfilelimit curview
7495     global diffencoding targetline diffnparents
7496     global git_version
7497
7498     set textconv {}
7499     if {[package vcompare $git_version "1.6.1"] >= 0} {
7500         set textconv "--textconv"
7501     }
7502     set cmd [diffcmd $ids "-p $textconv -C --cc --no-commit-id -U$diffcontext"]
7503     if {$ignorespace} {
7504         append cmd " -w"
7505     }
7506     if {$limitdiffs && $vfilelimit($curview) ne {}} {
7507         set cmd [concat $cmd -- $vfilelimit($curview)]
7508     }
7509     if {[catch {set bdf [open $cmd r]} err]} {
7510         error_popup [mc "Error getting diffs: %s" $err]
7511         return
7512     }
7513     set targetline {}
7514     set diffnparents 0
7515     set diffinhdr 0
7516     set diffencoding [get_path_encoding {}]
7517     fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
7518     set blobdifffd($ids) $bdf
7519     filerun $bdf [list getblobdiffline $bdf $diffids]
7520 }
7521
7522 proc savecmitpos {} {
7523     global ctext cmitmode
7524
7525     if {$cmitmode eq "tree"} {
7526         return {}
7527     }
7528     return [list target_scrollpos [$ctext index @0,0]]
7529 }
7530
7531 proc savectextpos {} {
7532     global ctext
7533
7534     return [list target_scrollpos [$ctext index @0,0]]
7535 }
7536
7537 proc maybe_scroll_ctext {ateof} {
7538     global ctext target_scrollpos
7539
7540     if {![info exists target_scrollpos]} return
7541     if {!$ateof} {
7542         set nlines [expr {[winfo height $ctext]
7543                           / [font metrics textfont -linespace]}]
7544         if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
7545     }
7546     $ctext yview $target_scrollpos
7547     unset target_scrollpos
7548 }
7549
7550 proc setinlist {var i val} {
7551     global $var
7552
7553     while {[llength [set $var]] < $i} {
7554         lappend $var {}
7555     }
7556     if {[llength [set $var]] == $i} {
7557         lappend $var $val
7558     } else {
7559         lset $var $i $val
7560     }
7561 }
7562
7563 proc makediffhdr {fname ids} {
7564     global ctext curdiffstart treediffs diffencoding
7565     global ctext_file_names jump_to_here targetline diffline
7566
7567     set fname [encoding convertfrom $fname]
7568     set diffencoding [get_path_encoding $fname]
7569     set i [lsearch -exact $treediffs($ids) $fname]
7570     if {$i >= 0} {
7571         setinlist difffilestart $i $curdiffstart
7572     }
7573     lset ctext_file_names end $fname
7574     set l [expr {(78 - [string length $fname]) / 2}]
7575     set pad [string range "----------------------------------------" 1 $l]
7576     $ctext insert $curdiffstart "$pad $fname $pad" filesep
7577     set targetline {}
7578     if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
7579         set targetline [lindex $jump_to_here 1]
7580     }
7581     set diffline 0
7582 }
7583
7584 proc getblobdiffline {bdf ids} {
7585     global diffids blobdifffd ctext curdiffstart
7586     global diffnexthead diffnextnote difffilestart
7587     global ctext_file_names ctext_file_lines
7588     global diffinhdr treediffs mergemax diffnparents
7589     global diffencoding jump_to_here targetline diffline
7590
7591     set nr 0
7592     $ctext conf -state normal
7593     while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
7594         if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
7595             catch {close $bdf}
7596             return 0
7597         }
7598         if {![string compare -length 5 "diff " $line]} {
7599             if {![regexp {^diff (--cc|--git) } $line m type]} {
7600                 set line [encoding convertfrom $line]
7601                 $ctext insert end "$line\n" hunksep
7602                 continue
7603             }
7604             # start of a new file
7605             set diffinhdr 1
7606             $ctext insert end "\n"
7607             set curdiffstart [$ctext index "end - 1c"]
7608             lappend ctext_file_names ""
7609             lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7610             $ctext insert end "\n" filesep
7611
7612             if {$type eq "--cc"} {
7613                 # start of a new file in a merge diff
7614                 set fname [string range $line 10 end]
7615                 if {[lsearch -exact $treediffs($ids) $fname] < 0} {
7616                     lappend treediffs($ids) $fname
7617                     add_flist [list $fname]
7618                 }
7619
7620             } else {
7621                 set line [string range $line 11 end]
7622                 # If the name hasn't changed the length will be odd,
7623                 # the middle char will be a space, and the two bits either
7624                 # side will be a/name and b/name, or "a/name" and "b/name".
7625                 # If the name has changed we'll get "rename from" and
7626                 # "rename to" or "copy from" and "copy to" lines following
7627                 # this, and we'll use them to get the filenames.
7628                 # This complexity is necessary because spaces in the
7629                 # filename(s) don't get escaped.
7630                 set l [string length $line]
7631                 set i [expr {$l / 2}]
7632                 if {!(($l & 1) && [string index $line $i] eq " " &&
7633                       [string range $line 2 [expr {$i - 1}]] eq \
7634                           [string range $line [expr {$i + 3}] end])} {
7635                     continue
7636                 }
7637                 # unescape if quoted and chop off the a/ from the front
7638                 if {[string index $line 0] eq "\""} {
7639                     set fname [string range [lindex $line 0] 2 end]
7640                 } else {
7641                     set fname [string range $line 2 [expr {$i - 1}]]
7642                 }
7643             }
7644             makediffhdr $fname $ids
7645
7646         } elseif {![string compare -length 16 "* Unmerged path " $line]} {
7647             set fname [encoding convertfrom [string range $line 16 end]]
7648             $ctext insert end "\n"
7649             set curdiffstart [$ctext index "end - 1c"]
7650             lappend ctext_file_names $fname
7651             lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7652             $ctext insert end "$line\n" filesep
7653             set i [lsearch -exact $treediffs($ids) $fname]
7654             if {$i >= 0} {
7655                 setinlist difffilestart $i $curdiffstart
7656             }
7657
7658         } elseif {![string compare -length 2 "@@" $line]} {
7659             regexp {^@@+} $line ats
7660             set line [encoding convertfrom $diffencoding $line]
7661             $ctext insert end "$line\n" hunksep
7662             if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
7663                 set diffline $nl
7664             }
7665             set diffnparents [expr {[string length $ats] - 1}]
7666             set diffinhdr 0
7667
7668         } elseif {$diffinhdr} {
7669             if {![string compare -length 12 "rename from " $line]} {
7670                 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
7671                 if {[string index $fname 0] eq "\""} {
7672                     set fname [lindex $fname 0]
7673                 }
7674                 set fname [encoding convertfrom $fname]
7675                 set i [lsearch -exact $treediffs($ids) $fname]
7676                 if {$i >= 0} {
7677                     setinlist difffilestart $i $curdiffstart
7678                 }
7679             } elseif {![string compare -length 10 $line "rename to "] ||
7680                       ![string compare -length 8 $line "copy to "]} {
7681                 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
7682                 if {[string index $fname 0] eq "\""} {
7683                     set fname [lindex $fname 0]
7684                 }
7685                 makediffhdr $fname $ids
7686             } elseif {[string compare -length 3 $line "---"] == 0} {
7687                 # do nothing
7688                 continue
7689             } elseif {[string compare -length 3 $line "+++"] == 0} {
7690                 set diffinhdr 0
7691                 continue
7692             }
7693             $ctext insert end "$line\n" filesep
7694
7695         } else {
7696             set line [string map {\x1A ^Z} \
7697                           [encoding convertfrom $diffencoding $line]]
7698             # parse the prefix - one ' ', '-' or '+' for each parent
7699             set prefix [string range $line 0 [expr {$diffnparents - 1}]]
7700             set tag [expr {$diffnparents > 1? "m": "d"}]
7701             if {[string trim $prefix " -+"] eq {}} {
7702                 # prefix only has " ", "-" and "+" in it: normal diff line
7703                 set num [string first "-" $prefix]
7704                 if {$num >= 0} {
7705                     # removed line, first parent with line is $num
7706                     if {$num >= $mergemax} {
7707                         set num "max"
7708                     }
7709                     $ctext insert end "$line\n" $tag$num
7710                 } else {
7711                     set tags {}
7712                     if {[string first "+" $prefix] >= 0} {
7713                         # added line
7714                         lappend tags ${tag}result
7715                         if {$diffnparents > 1} {
7716                             set num [string first " " $prefix]
7717                             if {$num >= 0} {
7718                                 if {$num >= $mergemax} {
7719                                     set num "max"
7720                                 }
7721                                 lappend tags m$num
7722                             }
7723                         }
7724                     }
7725                     if {$targetline ne {}} {
7726                         if {$diffline == $targetline} {
7727                             set seehere [$ctext index "end - 1 chars"]
7728                             set targetline {}
7729                         } else {
7730                             incr diffline
7731                         }
7732                     }
7733                     $ctext insert end "$line\n" $tags
7734                 }
7735             } else {
7736                 # "\ No newline at end of file",
7737                 # or something else we don't recognize
7738                 $ctext insert end "$line\n" hunksep
7739             }
7740         }
7741     }
7742     if {[info exists seehere]} {
7743         mark_ctext_line [lindex [split $seehere .] 0]
7744     }
7745     maybe_scroll_ctext [eof $bdf]
7746     $ctext conf -state disabled
7747     if {[eof $bdf]} {
7748         catch {close $bdf}
7749         return 0
7750     }
7751     return [expr {$nr >= 1000? 2: 1}]
7752 }
7753
7754 proc changediffdisp {} {
7755     global ctext diffelide
7756
7757     $ctext tag conf d0 -elide [lindex $diffelide 0]
7758     $ctext tag conf dresult -elide [lindex $diffelide 1]
7759 }
7760
7761 proc highlightfile {loc cline} {
7762     global ctext cflist cflist_top
7763
7764     $ctext yview $loc
7765     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
7766     $cflist tag add highlight $cline.0 "$cline.0 lineend"
7767     $cflist see $cline.0
7768     set cflist_top $cline
7769 }
7770
7771 proc prevfile {} {
7772     global difffilestart ctext cmitmode
7773
7774     if {$cmitmode eq "tree"} return
7775     set prev 0.0
7776     set prevline 1
7777     set here [$ctext index @0,0]
7778     foreach loc $difffilestart {
7779         if {[$ctext compare $loc >= $here]} {
7780             highlightfile $prev $prevline
7781             return
7782         }
7783         set prev $loc
7784         incr prevline
7785     }
7786     highlightfile $prev $prevline
7787 }
7788
7789 proc nextfile {} {
7790     global difffilestart ctext cmitmode
7791
7792     if {$cmitmode eq "tree"} return
7793     set here [$ctext index @0,0]
7794     set line 1
7795     foreach loc $difffilestart {
7796         incr line
7797         if {[$ctext compare $loc > $here]} {
7798             highlightfile $loc $line
7799             return
7800         }
7801     }
7802 }
7803
7804 proc clear_ctext {{first 1.0}} {
7805     global ctext smarktop smarkbot
7806     global ctext_file_names ctext_file_lines
7807     global pendinglinks
7808
7809     set l [lindex [split $first .] 0]
7810     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
7811         set smarktop $l
7812     }
7813     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
7814         set smarkbot $l
7815     }
7816     $ctext delete $first end
7817     if {$first eq "1.0"} {
7818         catch {unset pendinglinks}
7819     }
7820     set ctext_file_names {}
7821     set ctext_file_lines {}
7822 }
7823
7824 proc settabs {{firstab {}}} {
7825     global firsttabstop tabstop ctext have_tk85
7826
7827     if {$firstab ne {} && $have_tk85} {
7828         set firsttabstop $firstab
7829     }
7830     set w [font measure textfont "0"]
7831     if {$firsttabstop != 0} {
7832         $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
7833                                [expr {($firsttabstop + 2 * $tabstop) * $w}]]
7834     } elseif {$have_tk85 || $tabstop != 8} {
7835         $ctext conf -tabs [expr {$tabstop * $w}]
7836     } else {
7837         $ctext conf -tabs {}
7838     }
7839 }
7840
7841 proc incrsearch {name ix op} {
7842     global ctext searchstring searchdirn
7843
7844     $ctext tag remove found 1.0 end
7845     if {[catch {$ctext index anchor}]} {
7846         # no anchor set, use start of selection, or of visible area
7847         set sel [$ctext tag ranges sel]
7848         if {$sel ne {}} {
7849             $ctext mark set anchor [lindex $sel 0]
7850         } elseif {$searchdirn eq "-forwards"} {
7851             $ctext mark set anchor @0,0
7852         } else {
7853             $ctext mark set anchor @0,[winfo height $ctext]
7854         }
7855     }
7856     if {$searchstring ne {}} {
7857         set here [$ctext search $searchdirn -- $searchstring anchor]
7858         if {$here ne {}} {
7859             $ctext see $here
7860         }
7861         searchmarkvisible 1
7862     }
7863 }
7864
7865 proc dosearch {} {
7866     global sstring ctext searchstring searchdirn
7867
7868     focus $sstring
7869     $sstring icursor end
7870     set searchdirn -forwards
7871     if {$searchstring ne {}} {
7872         set sel [$ctext tag ranges sel]
7873         if {$sel ne {}} {
7874             set start "[lindex $sel 0] + 1c"
7875         } elseif {[catch {set start [$ctext index anchor]}]} {
7876             set start "@0,0"
7877         }
7878         set match [$ctext search -count mlen -- $searchstring $start]
7879         $ctext tag remove sel 1.0 end
7880         if {$match eq {}} {
7881             bell
7882             return
7883         }
7884         $ctext see $match
7885         set mend "$match + $mlen c"
7886         $ctext tag add sel $match $mend
7887         $ctext mark unset anchor
7888     }
7889 }
7890
7891 proc dosearchback {} {
7892     global sstring ctext searchstring searchdirn
7893
7894     focus $sstring
7895     $sstring icursor end
7896     set searchdirn -backwards
7897     if {$searchstring ne {}} {
7898         set sel [$ctext tag ranges sel]
7899         if {$sel ne {}} {
7900             set start [lindex $sel 0]
7901         } elseif {[catch {set start [$ctext index anchor]}]} {
7902             set start @0,[winfo height $ctext]
7903         }
7904         set match [$ctext search -backwards -count ml -- $searchstring $start]
7905         $ctext tag remove sel 1.0 end
7906         if {$match eq {}} {
7907             bell
7908             return
7909         }
7910         $ctext see $match
7911         set mend "$match + $ml c"
7912         $ctext tag add sel $match $mend
7913         $ctext mark unset anchor
7914     }
7915 }
7916
7917 proc searchmark {first last} {
7918     global ctext searchstring
7919
7920     set mend $first.0
7921     while {1} {
7922         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
7923         if {$match eq {}} break
7924         set mend "$match + $mlen c"
7925         $ctext tag add found $match $mend
7926     }
7927 }
7928
7929 proc searchmarkvisible {doall} {
7930     global ctext smarktop smarkbot
7931
7932     set topline [lindex [split [$ctext index @0,0] .] 0]
7933     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
7934     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
7935         # no overlap with previous
7936         searchmark $topline $botline
7937         set smarktop $topline
7938         set smarkbot $botline
7939     } else {
7940         if {$topline < $smarktop} {
7941             searchmark $topline [expr {$smarktop-1}]
7942             set smarktop $topline
7943         }
7944         if {$botline > $smarkbot} {
7945             searchmark [expr {$smarkbot+1}] $botline
7946             set smarkbot $botline
7947         }
7948     }
7949 }
7950
7951 proc scrolltext {f0 f1} {
7952     global searchstring
7953
7954     .bleft.bottom.sb set $f0 $f1
7955     if {$searchstring ne {}} {
7956         searchmarkvisible 0
7957     }
7958 }
7959
7960 proc setcoords {} {
7961     global linespc charspc canvx0 canvy0
7962     global xspc1 xspc2 lthickness
7963
7964     set linespc [font metrics mainfont -linespace]
7965     set charspc [font measure mainfont "m"]
7966     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
7967     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
7968     set lthickness [expr {int($linespc / 9) + 1}]
7969     set xspc1(0) $linespc
7970     set xspc2 $linespc
7971 }
7972
7973 proc redisplay {} {
7974     global canv
7975     global selectedline
7976
7977     set ymax [lindex [$canv cget -scrollregion] 3]
7978     if {$ymax eq {} || $ymax == 0} return
7979     set span [$canv yview]
7980     clear_display
7981     setcanvscroll
7982     allcanvs yview moveto [lindex $span 0]
7983     drawvisible
7984     if {$selectedline ne {}} {
7985         selectline $selectedline 0
7986         allcanvs yview moveto [lindex $span 0]
7987     }
7988 }
7989
7990 proc parsefont {f n} {
7991     global fontattr
7992
7993     set fontattr($f,family) [lindex $n 0]
7994     set s [lindex $n 1]
7995     if {$s eq {} || $s == 0} {
7996         set s 10
7997     } elseif {$s < 0} {
7998         set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
7999     }
8000     set fontattr($f,size) $s
8001     set fontattr($f,weight) normal
8002     set fontattr($f,slant) roman
8003     foreach style [lrange $n 2 end] {
8004         switch -- $style {
8005             "normal" -
8006             "bold"   {set fontattr($f,weight) $style}
8007             "roman" -
8008             "italic" {set fontattr($f,slant) $style}
8009         }
8010     }
8011 }
8012
8013 proc fontflags {f {isbold 0}} {
8014     global fontattr
8015
8016     return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8017                 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8018                 -slant $fontattr($f,slant)]
8019 }
8020
8021 proc fontname {f} {
8022     global fontattr
8023
8024     set n [list $fontattr($f,family) $fontattr($f,size)]
8025     if {$fontattr($f,weight) eq "bold"} {
8026         lappend n "bold"
8027     }
8028     if {$fontattr($f,slant) eq "italic"} {
8029         lappend n "italic"
8030     }
8031     return $n
8032 }
8033
8034 proc incrfont {inc} {
8035     global mainfont textfont ctext canv cflist showrefstop
8036     global stopped entries fontattr
8037
8038     unmarkmatches
8039     set s $fontattr(mainfont,size)
8040     incr s $inc
8041     if {$s < 1} {
8042         set s 1
8043     }
8044     set fontattr(mainfont,size) $s
8045     font config mainfont -size $s
8046     font config mainfontbold -size $s
8047     set mainfont [fontname mainfont]
8048     set s $fontattr(textfont,size)
8049     incr s $inc
8050     if {$s < 1} {
8051         set s 1
8052     }
8053     set fontattr(textfont,size) $s
8054     font config textfont -size $s
8055     font config textfontbold -size $s
8056     set textfont [fontname textfont]
8057     setcoords
8058     settabs
8059     redisplay
8060 }
8061
8062 proc clearsha1 {} {
8063     global sha1entry sha1string
8064     if {[string length $sha1string] == 40} {
8065         $sha1entry delete 0 end
8066     }
8067 }
8068
8069 proc sha1change {n1 n2 op} {
8070     global sha1string currentid sha1but
8071     if {$sha1string == {}
8072         || ([info exists currentid] && $sha1string == $currentid)} {
8073         set state disabled
8074     } else {
8075         set state normal
8076     }
8077     if {[$sha1but cget -state] == $state} return
8078     if {$state == "normal"} {
8079         $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
8080     } else {
8081         $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
8082     }
8083 }
8084
8085 proc gotocommit {} {
8086     global sha1string tagids headids curview varcid
8087
8088     if {$sha1string == {}
8089         || ([info exists currentid] && $sha1string == $currentid)} return
8090     if {[info exists tagids($sha1string)]} {
8091         set id $tagids($sha1string)
8092     } elseif {[info exists headids($sha1string)]} {
8093         set id $headids($sha1string)
8094     } else {
8095         set id [string tolower $sha1string]
8096         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
8097             set matches [longid $id]
8098             if {$matches ne {}} {
8099                 if {[llength $matches] > 1} {
8100                     error_popup [mc "Short SHA1 id %s is ambiguous" $id]
8101                     return
8102                 }
8103                 set id [lindex $matches 0]
8104             }
8105         } else {
8106             if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8107                 error_popup [mc "Revision %s is not known" $sha1string]
8108                 return
8109             }
8110         }
8111     }
8112     if {[commitinview $id $curview]} {
8113         selectline [rowofcommit $id] 1
8114         return
8115     }
8116     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
8117         set msg [mc "SHA1 id %s is not known" $sha1string]
8118     } else {
8119         set msg [mc "Revision %s is not in the current view" $sha1string]
8120     }
8121     error_popup $msg
8122 }
8123
8124 proc lineenter {x y id} {
8125     global hoverx hovery hoverid hovertimer
8126     global commitinfo canv
8127
8128     if {![info exists commitinfo($id)] && ![getcommit $id]} return
8129     set hoverx $x
8130     set hovery $y
8131     set hoverid $id
8132     if {[info exists hovertimer]} {
8133         after cancel $hovertimer
8134     }
8135     set hovertimer [after 500 linehover]
8136     $canv delete hover
8137 }
8138
8139 proc linemotion {x y id} {
8140     global hoverx hovery hoverid hovertimer
8141
8142     if {[info exists hoverid] && $id == $hoverid} {
8143         set hoverx $x
8144         set hovery $y
8145         if {[info exists hovertimer]} {
8146             after cancel $hovertimer
8147         }
8148         set hovertimer [after 500 linehover]
8149     }
8150 }
8151
8152 proc lineleave {id} {
8153     global hoverid hovertimer canv
8154
8155     if {[info exists hoverid] && $id == $hoverid} {
8156         $canv delete hover
8157         if {[info exists hovertimer]} {
8158             after cancel $hovertimer
8159             unset hovertimer
8160         }
8161         unset hoverid
8162     }
8163 }
8164
8165 proc linehover {} {
8166     global hoverx hovery hoverid hovertimer
8167     global canv linespc lthickness
8168     global commitinfo
8169
8170     set text [lindex $commitinfo($hoverid) 0]
8171     set ymax [lindex [$canv cget -scrollregion] 3]
8172     if {$ymax == {}} return
8173     set yfrac [lindex [$canv yview] 0]
8174     set x [expr {$hoverx + 2 * $linespc}]
8175     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8176     set x0 [expr {$x - 2 * $lthickness}]
8177     set y0 [expr {$y - 2 * $lthickness}]
8178     set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
8179     set y1 [expr {$y + $linespc + 2 * $lthickness}]
8180     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8181                -fill \#ffff80 -outline black -width 1 -tags hover]
8182     $canv raise $t
8183     set t [$canv create text $x $y -anchor nw -text $text -tags hover \
8184                -font mainfont]
8185     $canv raise $t
8186 }
8187
8188 proc clickisonarrow {id y} {
8189     global lthickness
8190
8191     set ranges [rowranges $id]
8192     set thresh [expr {2 * $lthickness + 6}]
8193     set n [expr {[llength $ranges] - 1}]
8194     for {set i 1} {$i < $n} {incr i} {
8195         set row [lindex $ranges $i]
8196         if {abs([yc $row] - $y) < $thresh} {
8197             return $i
8198         }
8199     }
8200     return {}
8201 }
8202
8203 proc arrowjump {id n y} {
8204     global canv
8205
8206     # 1 <-> 2, 3 <-> 4, etc...
8207     set n [expr {(($n - 1) ^ 1) + 1}]
8208     set row [lindex [rowranges $id] $n]
8209     set yt [yc $row]
8210     set ymax [lindex [$canv cget -scrollregion] 3]
8211     if {$ymax eq {} || $ymax <= 0} return
8212     set view [$canv yview]
8213     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8214     set yfrac [expr {$yt / $ymax - $yspan / 2}]
8215     if {$yfrac < 0} {
8216         set yfrac 0
8217     }
8218     allcanvs yview moveto $yfrac
8219 }
8220
8221 proc lineclick {x y id isnew} {
8222     global ctext commitinfo children canv thickerline curview
8223
8224     if {![info exists commitinfo($id)] && ![getcommit $id]} return
8225     unmarkmatches
8226     unselectline
8227     normalline
8228     $canv delete hover
8229     # draw this line thicker than normal
8230     set thickerline $id
8231     drawlines $id
8232     if {$isnew} {
8233         set ymax [lindex [$canv cget -scrollregion] 3]
8234         if {$ymax eq {}} return
8235         set yfrac [lindex [$canv yview] 0]
8236         set y [expr {$y + $yfrac * $ymax}]
8237     }
8238     set dirn [clickisonarrow $id $y]
8239     if {$dirn ne {}} {
8240         arrowjump $id $dirn $y
8241         return
8242     }
8243
8244     if {$isnew} {
8245         addtohistory [list lineclick $x $y $id 0] savectextpos
8246     }
8247     # fill the details pane with info about this line
8248     $ctext conf -state normal
8249     clear_ctext
8250     settabs 0
8251     $ctext insert end "[mc "Parent"]:\t"
8252     $ctext insert end $id link0
8253     setlink $id link0
8254     set info $commitinfo($id)
8255     $ctext insert end "\n\t[lindex $info 0]\n"
8256     $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8257     set date [formatdate [lindex $info 2]]
8258     $ctext insert end "\t[mc "Date"]:\t$date\n"
8259     set kids $children($curview,$id)
8260     if {$kids ne {}} {
8261         $ctext insert end "\n[mc "Children"]:"
8262         set i 0
8263         foreach child $kids {
8264             incr i
8265             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8266             set info $commitinfo($child)
8267             $ctext insert end "\n\t"
8268             $ctext insert end $child link$i
8269             setlink $child link$i
8270             $ctext insert end "\n\t[lindex $info 0]"
8271             $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8272             set date [formatdate [lindex $info 2]]
8273             $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8274         }
8275     }
8276     maybe_scroll_ctext 1
8277     $ctext conf -state disabled
8278     init_flist {}
8279 }
8280
8281 proc normalline {} {
8282     global thickerline
8283     if {[info exists thickerline]} {
8284         set id $thickerline
8285         unset thickerline
8286         drawlines $id
8287     }
8288 }
8289
8290 proc selbyid {id {isnew 1}} {
8291     global curview
8292     if {[commitinview $id $curview]} {
8293         selectline [rowofcommit $id] $isnew
8294     }
8295 }
8296
8297 proc mstime {} {
8298     global startmstime
8299     if {![info exists startmstime]} {
8300         set startmstime [clock clicks -milliseconds]
8301     }
8302     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8303 }
8304
8305 proc rowmenu {x y id} {
8306     global rowctxmenu selectedline rowmenuid curview
8307     global nullid nullid2 fakerowmenu mainhead markedid
8308
8309     stopfinding
8310     set rowmenuid $id
8311     if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8312         set state disabled
8313     } else {
8314         set state normal
8315     }
8316     if {$id ne $nullid && $id ne $nullid2} {
8317         set menu $rowctxmenu
8318         if {$mainhead ne {}} {
8319             $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead] -state normal
8320         } else {
8321             $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8322         }
8323         if {[info exists markedid] && $markedid ne $id} {
8324             $menu entryconfigure 9 -state normal
8325             $menu entryconfigure 10 -state normal
8326             $menu entryconfigure 11 -state normal
8327         } else {
8328             $menu entryconfigure 9 -state disabled
8329             $menu entryconfigure 10 -state disabled
8330             $menu entryconfigure 11 -state disabled
8331         }
8332     } else {
8333         set menu $fakerowmenu
8334     }
8335     $menu entryconfigure [mca "Diff this -> selected"] -state $state
8336     $menu entryconfigure [mca "Diff selected -> this"] -state $state
8337     $menu entryconfigure [mca "Make patch"] -state $state
8338     tk_popup $menu $x $y
8339 }
8340
8341 proc markhere {} {
8342     global rowmenuid markedid canv
8343
8344     set markedid $rowmenuid
8345     make_idmark $markedid
8346 }
8347
8348 proc gotomark {} {
8349     global markedid
8350
8351     if {[info exists markedid]} {
8352         selbyid $markedid
8353     }
8354 }
8355
8356 proc replace_by_kids {l r} {
8357     global curview children
8358
8359     set id [commitonrow $r]
8360     set l [lreplace $l 0 0]
8361     foreach kid $children($curview,$id) {
8362         lappend l [rowofcommit $kid]
8363     }
8364     return [lsort -integer -decreasing -unique $l]
8365 }
8366
8367 proc find_common_desc {} {
8368     global markedid rowmenuid curview children
8369
8370     if {![info exists markedid]} return
8371     if {![commitinview $markedid $curview] ||
8372         ![commitinview $rowmenuid $curview]} return
8373     #set t1 [clock clicks -milliseconds]
8374     set l1 [list [rowofcommit $markedid]]
8375     set l2 [list [rowofcommit $rowmenuid]]
8376     while 1 {
8377         set r1 [lindex $l1 0]
8378         set r2 [lindex $l2 0]
8379         if {$r1 eq {} || $r2 eq {}} break
8380         if {$r1 == $r2} {
8381             selectline $r1 1
8382             break
8383         }
8384         if {$r1 > $r2} {
8385             set l1 [replace_by_kids $l1 $r1]
8386         } else {
8387             set l2 [replace_by_kids $l2 $r2]
8388         }
8389     }
8390     #set t2 [clock clicks -milliseconds]
8391     #puts "took [expr {$t2-$t1}]ms"
8392 }
8393
8394 proc compare_commits {} {
8395     global markedid rowmenuid curview children
8396
8397     if {![info exists markedid]} return
8398     if {![commitinview $markedid $curview]} return
8399     addtohistory [list do_cmp_commits $markedid $rowmenuid]
8400     do_cmp_commits $markedid $rowmenuid
8401 }
8402
8403 proc getpatchid {id} {
8404     global patchids
8405
8406     if {![info exists patchids($id)]} {
8407         set cmd [diffcmd [list $id] {-p --root}]
8408         # trim off the initial "|"
8409         set cmd [lrange $cmd 1 end]
8410         if {[catch {
8411             set x [eval exec $cmd | git patch-id]
8412             set patchids($id) [lindex $x 0]
8413         }]} {
8414             set patchids($id) "error"
8415         }
8416     }
8417     return $patchids($id)
8418 }
8419
8420 proc do_cmp_commits {a b} {
8421     global ctext curview parents children patchids commitinfo
8422
8423     $ctext conf -state normal
8424     clear_ctext
8425     init_flist {}
8426     for {set i 0} {$i < 100} {incr i} {
8427         set skipa 0
8428         set skipb 0
8429         if {[llength $parents($curview,$a)] > 1} {
8430             appendshortlink $a [mc "Skipping merge commit "] "\n"
8431             set skipa 1
8432         } else {
8433             set patcha [getpatchid $a]
8434         }
8435         if {[llength $parents($curview,$b)] > 1} {
8436             appendshortlink $b [mc "Skipping merge commit "] "\n"
8437             set skipb 1
8438         } else {
8439             set patchb [getpatchid $b]
8440         }
8441         if {!$skipa && !$skipb} {
8442             set heada [lindex $commitinfo($a) 0]
8443             set headb [lindex $commitinfo($b) 0]
8444             if {$patcha eq "error"} {
8445                 appendshortlink $a [mc "Error getting patch ID for "] \
8446                     [mc " - stopping\n"]
8447                 break
8448             }
8449             if {$patchb eq "error"} {
8450                 appendshortlink $b [mc "Error getting patch ID for "] \
8451                     [mc " - stopping\n"]
8452                 break
8453             }
8454             if {$patcha eq $patchb} {
8455                 if {$heada eq $headb} {
8456                     appendshortlink $a [mc "Commit "]
8457                     appendshortlink $b " == " "  $heada\n"
8458                 } else {
8459                     appendshortlink $a [mc "Commit "] "  $heada\n"
8460                     appendshortlink $b [mc " is the same patch as\n       "] \
8461                         "  $headb\n"
8462                 }
8463                 set skipa 1
8464                 set skipb 1
8465             } else {
8466                 $ctext insert end "\n"
8467                 appendshortlink $a [mc "Commit "] "  $heada\n"
8468                 appendshortlink $b [mc " differs from\n       "] \
8469                     "  $headb\n"
8470                 $ctext insert end [mc "Diff of commits:\n\n"]
8471                 $ctext conf -state disabled
8472                 update
8473                 diffcommits $a $b
8474                 return
8475             }
8476         }
8477         if {$skipa} {
8478             set kids [real_children $curview,$a]
8479             if {[llength $kids] != 1} {
8480                 $ctext insert end "\n"
8481                 appendshortlink $a [mc "Commit "] \
8482                     [mc " has %s children - stopping\n" [llength $kids]]
8483                 break
8484             }
8485             set a [lindex $kids 0]
8486         }
8487         if {$skipb} {
8488             set kids [real_children $curview,$b]
8489             if {[llength $kids] != 1} {
8490                 appendshortlink $b [mc "Commit "] \
8491                     [mc " has %s children - stopping\n" [llength $kids]]
8492                 break
8493             }
8494             set b [lindex $kids 0]
8495         }
8496     }
8497     $ctext conf -state disabled
8498 }
8499
8500 proc diffcommits {a b} {
8501     global diffcontext diffids blobdifffd diffinhdr
8502
8503     set tmpdir [gitknewtmpdir]
8504     set fna [file join $tmpdir "commit-[string range $a 0 7]"]
8505     set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
8506     if {[catch {
8507         exec git diff-tree -p --pretty $a >$fna
8508         exec git diff-tree -p --pretty $b >$fnb
8509     } err]} {
8510         error_popup [mc "Error writing commit to file: %s" $err]
8511         return
8512     }
8513     if {[catch {
8514         set fd [open "| diff -U$diffcontext $fna $fnb" r]
8515     } err]} {
8516         error_popup [mc "Error diffing commits: %s" $err]
8517         return
8518     }
8519     set diffids [list commits $a $b]
8520     set blobdifffd($diffids) $fd
8521     set diffinhdr 0
8522     filerun $fd [list getblobdiffline $fd $diffids]
8523 }
8524
8525 proc diffvssel {dirn} {
8526     global rowmenuid selectedline
8527
8528     if {$selectedline eq {}} return
8529     if {$dirn} {
8530         set oldid [commitonrow $selectedline]
8531         set newid $rowmenuid
8532     } else {
8533         set oldid $rowmenuid
8534         set newid [commitonrow $selectedline]
8535     }
8536     addtohistory [list doseldiff $oldid $newid] savectextpos
8537     doseldiff $oldid $newid
8538 }
8539
8540 proc doseldiff {oldid newid} {
8541     global ctext
8542     global commitinfo
8543
8544     $ctext conf -state normal
8545     clear_ctext
8546     init_flist [mc "Top"]
8547     $ctext insert end "[mc "From"] "
8548     $ctext insert end $oldid link0
8549     setlink $oldid link0
8550     $ctext insert end "\n     "
8551     $ctext insert end [lindex $commitinfo($oldid) 0]
8552     $ctext insert end "\n\n[mc "To"]   "
8553     $ctext insert end $newid link1
8554     setlink $newid link1
8555     $ctext insert end "\n     "
8556     $ctext insert end [lindex $commitinfo($newid) 0]
8557     $ctext insert end "\n"
8558     $ctext conf -state disabled
8559     $ctext tag remove found 1.0 end
8560     startdiff [list $oldid $newid]
8561 }
8562
8563 proc mkpatch {} {
8564     global rowmenuid currentid commitinfo patchtop patchnum NS
8565
8566     if {![info exists currentid]} return
8567     set oldid $currentid
8568     set oldhead [lindex $commitinfo($oldid) 0]
8569     set newid $rowmenuid
8570     set newhead [lindex $commitinfo($newid) 0]
8571     set top .patch
8572     set patchtop $top
8573     catch {destroy $top}
8574     ttk_toplevel $top
8575     make_transient $top .
8576     ${NS}::label $top.title -text [mc "Generate patch"]
8577     grid $top.title - -pady 10
8578     ${NS}::label $top.from -text [mc "From:"]
8579     ${NS}::entry $top.fromsha1 -width 40
8580     $top.fromsha1 insert 0 $oldid
8581     $top.fromsha1 conf -state readonly
8582     grid $top.from $top.fromsha1 -sticky w
8583     ${NS}::entry $top.fromhead -width 60
8584     $top.fromhead insert 0 $oldhead
8585     $top.fromhead conf -state readonly
8586     grid x $top.fromhead -sticky w
8587     ${NS}::label $top.to -text [mc "To:"]
8588     ${NS}::entry $top.tosha1 -width 40
8589     $top.tosha1 insert 0 $newid
8590     $top.tosha1 conf -state readonly
8591     grid $top.to $top.tosha1 -sticky w
8592     ${NS}::entry $top.tohead -width 60
8593     $top.tohead insert 0 $newhead
8594     $top.tohead conf -state readonly
8595     grid x $top.tohead -sticky w
8596     ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
8597     grid $top.rev x -pady 10 -padx 5
8598     ${NS}::label $top.flab -text [mc "Output file:"]
8599     ${NS}::entry $top.fname -width 60
8600     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
8601     incr patchnum
8602     grid $top.flab $top.fname -sticky w
8603     ${NS}::frame $top.buts
8604     ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
8605     ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
8606     bind $top <Key-Return> mkpatchgo
8607     bind $top <Key-Escape> mkpatchcan
8608     grid $top.buts.gen $top.buts.can
8609     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8610     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8611     grid $top.buts - -pady 10 -sticky ew
8612     focus $top.fname
8613 }
8614
8615 proc mkpatchrev {} {
8616     global patchtop
8617
8618     set oldid [$patchtop.fromsha1 get]
8619     set oldhead [$patchtop.fromhead get]
8620     set newid [$patchtop.tosha1 get]
8621     set newhead [$patchtop.tohead get]
8622     foreach e [list fromsha1 fromhead tosha1 tohead] \
8623             v [list $newid $newhead $oldid $oldhead] {
8624         $patchtop.$e conf -state normal
8625         $patchtop.$e delete 0 end
8626         $patchtop.$e insert 0 $v
8627         $patchtop.$e conf -state readonly
8628     }
8629 }
8630
8631 proc mkpatchgo {} {
8632     global patchtop nullid nullid2
8633
8634     set oldid [$patchtop.fromsha1 get]
8635     set newid [$patchtop.tosha1 get]
8636     set fname [$patchtop.fname get]
8637     set cmd [diffcmd [list $oldid $newid] -p]
8638     # trim off the initial "|"
8639     set cmd [lrange $cmd 1 end]
8640     lappend cmd >$fname &
8641     if {[catch {eval exec $cmd} err]} {
8642         error_popup "[mc "Error creating patch:"] $err" $patchtop
8643     }
8644     catch {destroy $patchtop}
8645     unset patchtop
8646 }
8647
8648 proc mkpatchcan {} {
8649     global patchtop
8650
8651     catch {destroy $patchtop}
8652     unset patchtop
8653 }
8654
8655 proc mktag {} {
8656     global rowmenuid mktagtop commitinfo NS
8657
8658     set top .maketag
8659     set mktagtop $top
8660     catch {destroy $top}
8661     ttk_toplevel $top
8662     make_transient $top .
8663     ${NS}::label $top.title -text [mc "Create tag"]
8664     grid $top.title - -pady 10
8665     ${NS}::label $top.id -text [mc "ID:"]
8666     ${NS}::entry $top.sha1 -width 40
8667     $top.sha1 insert 0 $rowmenuid
8668     $top.sha1 conf -state readonly
8669     grid $top.id $top.sha1 -sticky w
8670     ${NS}::entry $top.head -width 60
8671     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8672     $top.head conf -state readonly
8673     grid x $top.head -sticky w
8674     ${NS}::label $top.tlab -text [mc "Tag name:"]
8675     ${NS}::entry $top.tag -width 60
8676     grid $top.tlab $top.tag -sticky w
8677     ${NS}::frame $top.buts
8678     ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
8679     ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
8680     bind $top <Key-Return> mktaggo
8681     bind $top <Key-Escape> mktagcan
8682     grid $top.buts.gen $top.buts.can
8683     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8684     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8685     grid $top.buts - -pady 10 -sticky ew
8686     focus $top.tag
8687 }
8688
8689 proc domktag {} {
8690     global mktagtop env tagids idtags
8691
8692     set id [$mktagtop.sha1 get]
8693     set tag [$mktagtop.tag get]
8694     if {$tag == {}} {
8695         error_popup [mc "No tag name specified"] $mktagtop
8696         return 0
8697     }
8698     if {[info exists tagids($tag)]} {
8699         error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
8700         return 0
8701     }
8702     if {[catch {
8703         exec git tag $tag $id
8704     } err]} {
8705         error_popup "[mc "Error creating tag:"] $err" $mktagtop
8706         return 0
8707     }
8708
8709     set tagids($tag) $id
8710     lappend idtags($id) $tag
8711     redrawtags $id
8712     addedtag $id
8713     dispneartags 0
8714     run refill_reflist
8715     return 1
8716 }
8717
8718 proc redrawtags {id} {
8719     global canv linehtag idpos currentid curview cmitlisted markedid
8720     global canvxmax iddrawn circleitem mainheadid circlecolors
8721
8722     if {![commitinview $id $curview]} return
8723     if {![info exists iddrawn($id)]} return
8724     set row [rowofcommit $id]
8725     if {$id eq $mainheadid} {
8726         set ofill yellow
8727     } else {
8728         set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
8729     }
8730     $canv itemconf $circleitem($row) -fill $ofill
8731     $canv delete tag.$id
8732     set xt [eval drawtags $id $idpos($id)]
8733     $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
8734     set text [$canv itemcget $linehtag($id) -text]
8735     set font [$canv itemcget $linehtag($id) -font]
8736     set xr [expr {$xt + [font measure $font $text]}]
8737     if {$xr > $canvxmax} {
8738         set canvxmax $xr
8739         setcanvscroll
8740     }
8741     if {[info exists currentid] && $currentid == $id} {
8742         make_secsel $id
8743     }
8744     if {[info exists markedid] && $markedid eq $id} {
8745         make_idmark $id
8746     }
8747 }
8748
8749 proc mktagcan {} {
8750     global mktagtop
8751
8752     catch {destroy $mktagtop}
8753     unset mktagtop
8754 }
8755
8756 proc mktaggo {} {
8757     if {![domktag]} return
8758     mktagcan
8759 }
8760
8761 proc writecommit {} {
8762     global rowmenuid wrcomtop commitinfo wrcomcmd NS
8763
8764     set top .writecommit
8765     set wrcomtop $top
8766     catch {destroy $top}
8767     ttk_toplevel $top
8768     make_transient $top .
8769     ${NS}::label $top.title -text [mc "Write commit to file"]
8770     grid $top.title - -pady 10
8771     ${NS}::label $top.id -text [mc "ID:"]
8772     ${NS}::entry $top.sha1 -width 40
8773     $top.sha1 insert 0 $rowmenuid
8774     $top.sha1 conf -state readonly
8775     grid $top.id $top.sha1 -sticky w
8776     ${NS}::entry $top.head -width 60
8777     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8778     $top.head conf -state readonly
8779     grid x $top.head -sticky w
8780     ${NS}::label $top.clab -text [mc "Command:"]
8781     ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
8782     grid $top.clab $top.cmd -sticky w -pady 10
8783     ${NS}::label $top.flab -text [mc "Output file:"]
8784     ${NS}::entry $top.fname -width 60
8785     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
8786     grid $top.flab $top.fname -sticky w
8787     ${NS}::frame $top.buts
8788     ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
8789     ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
8790     bind $top <Key-Return> wrcomgo
8791     bind $top <Key-Escape> wrcomcan
8792     grid $top.buts.gen $top.buts.can
8793     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8794     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8795     grid $top.buts - -pady 10 -sticky ew
8796     focus $top.fname
8797 }
8798
8799 proc wrcomgo {} {
8800     global wrcomtop
8801
8802     set id [$wrcomtop.sha1 get]
8803     set cmd "echo $id | [$wrcomtop.cmd get]"
8804     set fname [$wrcomtop.fname get]
8805     if {[catch {exec sh -c $cmd >$fname &} err]} {
8806         error_popup "[mc "Error writing commit:"] $err" $wrcomtop
8807     }
8808     catch {destroy $wrcomtop}
8809     unset wrcomtop
8810 }
8811
8812 proc wrcomcan {} {
8813     global wrcomtop
8814
8815     catch {destroy $wrcomtop}
8816     unset wrcomtop
8817 }
8818
8819 proc mkbranch {} {
8820     global rowmenuid mkbrtop NS
8821
8822     set top .makebranch
8823     catch {destroy $top}
8824     ttk_toplevel $top
8825     make_transient $top .
8826     ${NS}::label $top.title -text [mc "Create new branch"]
8827     grid $top.title - -pady 10
8828     ${NS}::label $top.id -text [mc "ID:"]
8829     ${NS}::entry $top.sha1 -width 40
8830     $top.sha1 insert 0 $rowmenuid
8831     $top.sha1 conf -state readonly
8832     grid $top.id $top.sha1 -sticky w
8833     ${NS}::label $top.nlab -text [mc "Name:"]
8834     ${NS}::entry $top.name -width 40
8835     grid $top.nlab $top.name -sticky w
8836     ${NS}::frame $top.buts
8837     ${NS}::button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
8838     ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
8839     bind $top <Key-Return> [list mkbrgo $top]
8840     bind $top <Key-Escape> "catch {destroy $top}"
8841     grid $top.buts.go $top.buts.can
8842     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8843     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8844     grid $top.buts - -pady 10 -sticky ew
8845     focus $top.name
8846 }
8847
8848 proc mkbrgo {top} {
8849     global headids idheads
8850
8851     set name [$top.name get]
8852     set id [$top.sha1 get]
8853     set cmdargs {}
8854     set old_id {}
8855     if {$name eq {}} {
8856         error_popup [mc "Please specify a name for the new branch"] $top
8857         return
8858     }
8859     if {[info exists headids($name)]} {
8860         if {![confirm_popup [mc \
8861                 "Branch '%s' already exists. Overwrite?" $name] $top]} {
8862             return
8863         }
8864         set old_id $headids($name)
8865         lappend cmdargs -f
8866     }
8867     catch {destroy $top}
8868     lappend cmdargs $name $id
8869     nowbusy newbranch
8870     update
8871     if {[catch {
8872         eval exec git branch $cmdargs
8873     } err]} {
8874         notbusy newbranch
8875         error_popup $err
8876     } else {
8877         notbusy newbranch
8878         if {$old_id ne {}} {
8879             movehead $id $name
8880             movedhead $id $name
8881             redrawtags $old_id
8882             redrawtags $id
8883         } else {
8884             set headids($name) $id
8885             lappend idheads($id) $name
8886             addedhead $id $name
8887             redrawtags $id
8888         }
8889         dispneartags 0
8890         run refill_reflist
8891     }
8892 }
8893
8894 proc exec_citool {tool_args {baseid {}}} {
8895     global commitinfo env
8896
8897     set save_env [array get env GIT_AUTHOR_*]
8898
8899     if {$baseid ne {}} {
8900         if {![info exists commitinfo($baseid)]} {
8901             getcommit $baseid
8902         }
8903         set author [lindex $commitinfo($baseid) 1]
8904         set date [lindex $commitinfo($baseid) 2]
8905         if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
8906                     $author author name email]
8907             && $date ne {}} {
8908             set env(GIT_AUTHOR_NAME) $name
8909             set env(GIT_AUTHOR_EMAIL) $email
8910             set env(GIT_AUTHOR_DATE) $date
8911         }
8912     }
8913
8914     eval exec git citool $tool_args &
8915
8916     array unset env GIT_AUTHOR_*
8917     array set env $save_env
8918 }
8919
8920 proc cherrypick {} {
8921     global rowmenuid curview
8922     global mainhead mainheadid
8923
8924     set oldhead [exec git rev-parse HEAD]
8925     set dheads [descheads $rowmenuid]
8926     if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
8927         set ok [confirm_popup [mc "Commit %s is already\
8928                 included in branch %s -- really re-apply it?" \
8929                                    [string range $rowmenuid 0 7] $mainhead]]
8930         if {!$ok} return
8931     }
8932     nowbusy cherrypick [mc "Cherry-picking"]
8933     update
8934     # Unfortunately git-cherry-pick writes stuff to stderr even when
8935     # no error occurs, and exec takes that as an indication of error...
8936     if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
8937         notbusy cherrypick
8938         if {[regexp -line \
8939                  {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
8940                  $err msg fname]} {
8941             error_popup [mc "Cherry-pick failed because of local changes\
8942                         to file '%s'.\nPlease commit, reset or stash\
8943                         your changes and try again." $fname]
8944         } elseif {[regexp -line \
8945                        {^(CONFLICT \(.*\):|Automatic cherry-pick failed)} \
8946                        $err]} {
8947             if {[confirm_popup [mc "Cherry-pick failed because of merge\
8948                         conflict.\nDo you wish to run git citool to\
8949                         resolve it?"]]} {
8950                 # Force citool to read MERGE_MSG
8951                 file delete [file join [gitdir] "GITGUI_MSG"]
8952                 exec_citool {} $rowmenuid
8953             }
8954         } else {
8955             error_popup $err
8956         }
8957         run updatecommits
8958         return
8959     }
8960     set newhead [exec git rev-parse HEAD]
8961     if {$newhead eq $oldhead} {
8962         notbusy cherrypick
8963         error_popup [mc "No changes committed"]
8964         return
8965     }
8966     addnewchild $newhead $oldhead
8967     if {[commitinview $oldhead $curview]} {
8968         # XXX this isn't right if we have a path limit...
8969         insertrow $newhead $oldhead $curview
8970         if {$mainhead ne {}} {
8971             movehead $newhead $mainhead
8972             movedhead $newhead $mainhead
8973         }
8974         set mainheadid $newhead
8975         redrawtags $oldhead
8976         redrawtags $newhead
8977         selbyid $newhead
8978     }
8979     notbusy cherrypick
8980 }
8981
8982 proc resethead {} {
8983     global mainhead rowmenuid confirm_ok resettype NS
8984
8985     set confirm_ok 0
8986     set w ".confirmreset"
8987     ttk_toplevel $w
8988     make_transient $w .
8989     wm title $w [mc "Confirm reset"]
8990     ${NS}::label $w.m -text \
8991         [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
8992     pack $w.m -side top -fill x -padx 20 -pady 20
8993     ${NS}::labelframe $w.f -text [mc "Reset type:"]
8994     set resettype mixed
8995     ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
8996         -text [mc "Soft: Leave working tree and index untouched"]
8997     grid $w.f.soft -sticky w
8998     ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
8999         -text [mc "Mixed: Leave working tree untouched, reset index"]
9000     grid $w.f.mixed -sticky w
9001     ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
9002         -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
9003     grid $w.f.hard -sticky w
9004     pack $w.f -side top -fill x -padx 4
9005     ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
9006     pack $w.ok -side left -fill x -padx 20 -pady 20
9007     ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
9008     bind $w <Key-Escape> [list destroy $w]
9009     pack $w.cancel -side right -fill x -padx 20 -pady 20
9010     bind $w <Visibility> "grab $w; focus $w"
9011     tkwait window $w
9012     if {!$confirm_ok} return
9013     if {[catch {set fd [open \
9014             [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
9015         error_popup $err
9016     } else {
9017         dohidelocalchanges
9018         filerun $fd [list readresetstat $fd]
9019         nowbusy reset [mc "Resetting"]
9020         selbyid $rowmenuid
9021     }
9022 }
9023
9024 proc readresetstat {fd} {
9025     global mainhead mainheadid showlocalchanges rprogcoord
9026
9027     if {[gets $fd line] >= 0} {
9028         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9029             set rprogcoord [expr {1.0 * $m / $n}]
9030             adjustprogress
9031         }
9032         return 1
9033     }
9034     set rprogcoord 0
9035     adjustprogress
9036     notbusy reset
9037     if {[catch {close $fd} err]} {
9038         error_popup $err
9039     }
9040     set oldhead $mainheadid
9041     set newhead [exec git rev-parse HEAD]
9042     if {$newhead ne $oldhead} {
9043         movehead $newhead $mainhead
9044         movedhead $newhead $mainhead
9045         set mainheadid $newhead
9046         redrawtags $oldhead
9047         redrawtags $newhead
9048     }
9049     if {$showlocalchanges} {
9050         doshowlocalchanges
9051     }
9052     return 0
9053 }
9054
9055 # context menu for a head
9056 proc headmenu {x y id head} {
9057     global headmenuid headmenuhead headctxmenu mainhead
9058
9059     stopfinding
9060     set headmenuid $id
9061     set headmenuhead $head
9062     set state normal
9063     if {$head eq $mainhead} {
9064         set state disabled
9065     }
9066     $headctxmenu entryconfigure 0 -state $state
9067     $headctxmenu entryconfigure 1 -state $state
9068     tk_popup $headctxmenu $x $y
9069 }
9070
9071 proc cobranch {} {
9072     global headmenuid headmenuhead headids
9073     global showlocalchanges
9074
9075     # check the tree is clean first??
9076     nowbusy checkout [mc "Checking out"]
9077     update
9078     dohidelocalchanges
9079     if {[catch {
9080         set fd [open [list | git checkout $headmenuhead 2>@1] r]
9081     } err]} {
9082         notbusy checkout
9083         error_popup $err
9084         if {$showlocalchanges} {
9085             dodiffindex
9086         }
9087     } else {
9088         filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
9089     }
9090 }
9091
9092 proc readcheckoutstat {fd newhead newheadid} {
9093     global mainhead mainheadid headids showlocalchanges progresscoords
9094     global viewmainheadid curview
9095
9096     if {[gets $fd line] >= 0} {
9097         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9098             set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9099             adjustprogress
9100         }
9101         return 1
9102     }
9103     set progresscoords {0 0}
9104     adjustprogress
9105     notbusy checkout
9106     if {[catch {close $fd} err]} {
9107         error_popup $err
9108     }
9109     set oldmainid $mainheadid
9110     set mainhead $newhead
9111     set mainheadid $newheadid
9112     set viewmainheadid($curview) $newheadid
9113     redrawtags $oldmainid
9114     redrawtags $newheadid
9115     selbyid $newheadid
9116     if {$showlocalchanges} {
9117         dodiffindex
9118     }
9119 }
9120
9121 proc rmbranch {} {
9122     global headmenuid headmenuhead mainhead
9123     global idheads
9124
9125     set head $headmenuhead
9126     set id $headmenuid
9127     # this check shouldn't be needed any more...
9128     if {$head eq $mainhead} {
9129         error_popup [mc "Cannot delete the currently checked-out branch"]
9130         return
9131     }
9132     set dheads [descheads $id]
9133     if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
9134         # the stuff on this branch isn't on any other branch
9135         if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9136                         branch.\nReally delete branch %s?" $head $head]]} return
9137     }
9138     nowbusy rmbranch
9139     update
9140     if {[catch {exec git branch -D $head} err]} {
9141         notbusy rmbranch
9142         error_popup $err
9143         return
9144     }
9145     removehead $id $head
9146     removedhead $id $head
9147     redrawtags $id
9148     notbusy rmbranch
9149     dispneartags 0
9150     run refill_reflist
9151 }
9152
9153 # Display a list of tags and heads
9154 proc showrefs {} {
9155     global showrefstop bgcolor fgcolor selectbgcolor NS
9156     global bglist fglist reflistfilter reflist maincursor
9157
9158     set top .showrefs
9159     set showrefstop $top
9160     if {[winfo exists $top]} {
9161         raise $top
9162         refill_reflist
9163         return
9164     }
9165     ttk_toplevel $top
9166     wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
9167     make_transient $top .
9168     text $top.list -background $bgcolor -foreground $fgcolor \
9169         -selectbackground $selectbgcolor -font mainfont \
9170         -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
9171         -width 30 -height 20 -cursor $maincursor \
9172         -spacing1 1 -spacing3 1 -state disabled
9173     $top.list tag configure highlight -background $selectbgcolor
9174     lappend bglist $top.list
9175     lappend fglist $top.list
9176     ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
9177     ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
9178     grid $top.list $top.ysb -sticky nsew
9179     grid $top.xsb x -sticky ew
9180     ${NS}::frame $top.f
9181     ${NS}::label $top.f.l -text "[mc "Filter"]: "
9182     ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
9183     set reflistfilter "*"
9184     trace add variable reflistfilter write reflistfilter_change
9185     pack $top.f.e -side right -fill x -expand 1
9186     pack $top.f.l -side left
9187     grid $top.f - -sticky ew -pady 2
9188     ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
9189     bind $top <Key-Escape> [list destroy $top]
9190     grid $top.close -
9191     grid columnconfigure $top 0 -weight 1
9192     grid rowconfigure $top 0 -weight 1
9193     bind $top.list <1> {break}
9194     bind $top.list <B1-Motion> {break}
9195     bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
9196     set reflist {}
9197     refill_reflist
9198 }
9199
9200 proc sel_reflist {w x y} {
9201     global showrefstop reflist headids tagids otherrefids
9202
9203     if {![winfo exists $showrefstop]} return
9204     set l [lindex [split [$w index "@$x,$y"] "."] 0]
9205     set ref [lindex $reflist [expr {$l-1}]]
9206     set n [lindex $ref 0]
9207     switch -- [lindex $ref 1] {
9208         "H" {selbyid $headids($n)}
9209         "T" {selbyid $tagids($n)}
9210         "o" {selbyid $otherrefids($n)}
9211     }
9212     $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
9213 }
9214
9215 proc unsel_reflist {} {
9216     global showrefstop
9217
9218     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9219     $showrefstop.list tag remove highlight 0.0 end
9220 }
9221
9222 proc reflistfilter_change {n1 n2 op} {
9223     global reflistfilter
9224
9225     after cancel refill_reflist
9226     after 200 refill_reflist
9227 }
9228
9229 proc refill_reflist {} {
9230     global reflist reflistfilter showrefstop headids tagids otherrefids
9231     global curview
9232
9233     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9234     set refs {}
9235     foreach n [array names headids] {
9236         if {[string match $reflistfilter $n]} {
9237             if {[commitinview $headids($n) $curview]} {
9238                 lappend refs [list $n H]
9239             } else {
9240                 interestedin $headids($n) {run refill_reflist}
9241             }
9242         }
9243     }
9244     foreach n [array names tagids] {
9245         if {[string match $reflistfilter $n]} {
9246             if {[commitinview $tagids($n) $curview]} {
9247                 lappend refs [list $n T]
9248             } else {
9249                 interestedin $tagids($n) {run refill_reflist}
9250             }
9251         }
9252     }
9253     foreach n [array names otherrefids] {
9254         if {[string match $reflistfilter $n]} {
9255             if {[commitinview $otherrefids($n) $curview]} {
9256                 lappend refs [list $n o]
9257             } else {
9258                 interestedin $otherrefids($n) {run refill_reflist}
9259             }
9260         }
9261     }
9262     set refs [lsort -index 0 $refs]
9263     if {$refs eq $reflist} return
9264
9265     # Update the contents of $showrefstop.list according to the
9266     # differences between $reflist (old) and $refs (new)
9267     $showrefstop.list conf -state normal
9268     $showrefstop.list insert end "\n"
9269     set i 0
9270     set j 0
9271     while {$i < [llength $reflist] || $j < [llength $refs]} {
9272         if {$i < [llength $reflist]} {
9273             if {$j < [llength $refs]} {
9274                 set cmp [string compare [lindex $reflist $i 0] \
9275                              [lindex $refs $j 0]]
9276                 if {$cmp == 0} {
9277                     set cmp [string compare [lindex $reflist $i 1] \
9278                                  [lindex $refs $j 1]]
9279                 }
9280             } else {
9281                 set cmp -1
9282             }
9283         } else {
9284             set cmp 1
9285         }
9286         switch -- $cmp {
9287             -1 {
9288                 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
9289                 incr i
9290             }
9291             0 {
9292                 incr i
9293                 incr j
9294             }
9295             1 {
9296                 set l [expr {$j + 1}]
9297                 $showrefstop.list image create $l.0 -align baseline \
9298                     -image reficon-[lindex $refs $j 1] -padx 2
9299                 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
9300                 incr j
9301             }
9302         }
9303     }
9304     set reflist $refs
9305     # delete last newline
9306     $showrefstop.list delete end-2c end-1c
9307     $showrefstop.list conf -state disabled
9308 }
9309
9310 # Stuff for finding nearby tags
9311 proc getallcommits {} {
9312     global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
9313     global idheads idtags idotherrefs allparents tagobjid
9314
9315     if {![info exists allcommits]} {
9316         set nextarc 0
9317         set allcommits 0
9318         set seeds {}
9319         set allcwait 0
9320         set cachedarcs 0
9321         set allccache [file join [gitdir] "gitk.cache"]
9322         if {![catch {
9323             set f [open $allccache r]
9324             set allcwait 1
9325             getcache $f
9326         }]} return
9327     }
9328
9329     if {$allcwait} {
9330         return
9331     }
9332     set cmd [list | git rev-list --parents]
9333     set allcupdate [expr {$seeds ne {}}]
9334     if {!$allcupdate} {
9335         set ids "--all"
9336     } else {
9337         set refs [concat [array names idheads] [array names idtags] \
9338                       [array names idotherrefs]]
9339         set ids {}
9340         set tagobjs {}
9341         foreach name [array names tagobjid] {
9342             lappend tagobjs $tagobjid($name)
9343         }
9344         foreach id [lsort -unique $refs] {
9345             if {![info exists allparents($id)] &&
9346                 [lsearch -exact $tagobjs $id] < 0} {
9347                 lappend ids $id
9348             }
9349         }
9350         if {$ids ne {}} {
9351             foreach id $seeds {
9352                 lappend ids "^$id"
9353             }
9354         }
9355     }
9356     if {$ids ne {}} {
9357         set fd [open [concat $cmd $ids] r]
9358         fconfigure $fd -blocking 0
9359         incr allcommits
9360         nowbusy allcommits
9361         filerun $fd [list getallclines $fd]
9362     } else {
9363         dispneartags 0
9364     }
9365 }
9366
9367 # Since most commits have 1 parent and 1 child, we group strings of
9368 # such commits into "arcs" joining branch/merge points (BMPs), which
9369 # are commits that either don't have 1 parent or don't have 1 child.
9370 #
9371 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
9372 # arcout(id) - outgoing arcs for BMP
9373 # arcids(a) - list of IDs on arc including end but not start
9374 # arcstart(a) - BMP ID at start of arc
9375 # arcend(a) - BMP ID at end of arc
9376 # growing(a) - arc a is still growing
9377 # arctags(a) - IDs out of arcids (excluding end) that have tags
9378 # archeads(a) - IDs out of arcids (excluding end) that have heads
9379 # The start of an arc is at the descendent end, so "incoming" means
9380 # coming from descendents, and "outgoing" means going towards ancestors.
9381
9382 proc getallclines {fd} {
9383     global allparents allchildren idtags idheads nextarc
9384     global arcnos arcids arctags arcout arcend arcstart archeads growing
9385     global seeds allcommits cachedarcs allcupdate
9386
9387     set nid 0
9388     while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
9389         set id [lindex $line 0]
9390         if {[info exists allparents($id)]} {
9391             # seen it already
9392             continue
9393         }
9394         set cachedarcs 0
9395         set olds [lrange $line 1 end]
9396         set allparents($id) $olds
9397         if {![info exists allchildren($id)]} {
9398             set allchildren($id) {}
9399             set arcnos($id) {}
9400             lappend seeds $id
9401         } else {
9402             set a $arcnos($id)
9403             if {[llength $olds] == 1 && [llength $a] == 1} {
9404                 lappend arcids($a) $id
9405                 if {[info exists idtags($id)]} {
9406                     lappend arctags($a) $id
9407                 }
9408                 if {[info exists idheads($id)]} {
9409                     lappend archeads($a) $id
9410                 }
9411                 if {[info exists allparents($olds)]} {
9412                     # seen parent already
9413                     if {![info exists arcout($olds)]} {
9414                         splitarc $olds
9415                     }
9416                     lappend arcids($a) $olds
9417                     set arcend($a) $olds
9418                     unset growing($a)
9419                 }
9420                 lappend allchildren($olds) $id
9421                 lappend arcnos($olds) $a
9422                 continue
9423             }
9424         }
9425         foreach a $arcnos($id) {
9426             lappend arcids($a) $id
9427             set arcend($a) $id
9428             unset growing($a)
9429         }
9430
9431         set ao {}
9432         foreach p $olds {
9433             lappend allchildren($p) $id
9434             set a [incr nextarc]
9435             set arcstart($a) $id
9436             set archeads($a) {}
9437             set arctags($a) {}
9438             set archeads($a) {}
9439             set arcids($a) {}
9440             lappend ao $a
9441             set growing($a) 1
9442             if {[info exists allparents($p)]} {
9443                 # seen it already, may need to make a new branch
9444                 if {![info exists arcout($p)]} {
9445                     splitarc $p
9446                 }
9447                 lappend arcids($a) $p
9448                 set arcend($a) $p
9449                 unset growing($a)
9450             }
9451             lappend arcnos($p) $a
9452         }
9453         set arcout($id) $ao
9454     }
9455     if {$nid > 0} {
9456         global cached_dheads cached_dtags cached_atags
9457         catch {unset cached_dheads}
9458         catch {unset cached_dtags}
9459         catch {unset cached_atags}
9460     }
9461     if {![eof $fd]} {
9462         return [expr {$nid >= 1000? 2: 1}]
9463     }
9464     set cacheok 1
9465     if {[catch {
9466         fconfigure $fd -blocking 1
9467         close $fd
9468     } err]} {
9469         # got an error reading the list of commits
9470         # if we were updating, try rereading the whole thing again
9471         if {$allcupdate} {
9472             incr allcommits -1
9473             dropcache $err
9474             return
9475         }
9476         error_popup "[mc "Error reading commit topology information;\
9477                 branch and preceding/following tag information\
9478                 will be incomplete."]\n($err)"
9479         set cacheok 0
9480     }
9481     if {[incr allcommits -1] == 0} {
9482         notbusy allcommits
9483         if {$cacheok} {
9484             run savecache
9485         }
9486     }
9487     dispneartags 0
9488     return 0
9489 }
9490
9491 proc recalcarc {a} {
9492     global arctags archeads arcids idtags idheads
9493
9494     set at {}
9495     set ah {}
9496     foreach id [lrange $arcids($a) 0 end-1] {
9497         if {[info exists idtags($id)]} {
9498             lappend at $id
9499         }
9500         if {[info exists idheads($id)]} {
9501             lappend ah $id
9502         }
9503     }
9504     set arctags($a) $at
9505     set archeads($a) $ah
9506 }
9507
9508 proc splitarc {p} {
9509     global arcnos arcids nextarc arctags archeads idtags idheads
9510     global arcstart arcend arcout allparents growing
9511
9512     set a $arcnos($p)
9513     if {[llength $a] != 1} {
9514         puts "oops splitarc called but [llength $a] arcs already"
9515         return
9516     }
9517     set a [lindex $a 0]
9518     set i [lsearch -exact $arcids($a) $p]
9519     if {$i < 0} {
9520         puts "oops splitarc $p not in arc $a"
9521         return
9522     }
9523     set na [incr nextarc]
9524     if {[info exists arcend($a)]} {
9525         set arcend($na) $arcend($a)
9526     } else {
9527         set l [lindex $allparents([lindex $arcids($a) end]) 0]
9528         set j [lsearch -exact $arcnos($l) $a]
9529         set arcnos($l) [lreplace $arcnos($l) $j $j $na]
9530     }
9531     set tail [lrange $arcids($a) [expr {$i+1}] end]
9532     set arcids($a) [lrange $arcids($a) 0 $i]
9533     set arcend($a) $p
9534     set arcstart($na) $p
9535     set arcout($p) $na
9536     set arcids($na) $tail
9537     if {[info exists growing($a)]} {
9538         set growing($na) 1
9539         unset growing($a)
9540     }
9541
9542     foreach id $tail {
9543         if {[llength $arcnos($id)] == 1} {
9544             set arcnos($id) $na
9545         } else {
9546             set j [lsearch -exact $arcnos($id) $a]
9547             set arcnos($id) [lreplace $arcnos($id) $j $j $na]
9548         }
9549     }
9550
9551     # reconstruct tags and heads lists
9552     if {$arctags($a) ne {} || $archeads($a) ne {}} {
9553         recalcarc $a
9554         recalcarc $na
9555     } else {
9556         set arctags($na) {}
9557         set archeads($na) {}
9558     }
9559 }
9560
9561 # Update things for a new commit added that is a child of one
9562 # existing commit.  Used when cherry-picking.
9563 proc addnewchild {id p} {
9564     global allparents allchildren idtags nextarc
9565     global arcnos arcids arctags arcout arcend arcstart archeads growing
9566     global seeds allcommits
9567
9568     if {![info exists allcommits] || ![info exists arcnos($p)]} return
9569     set allparents($id) [list $p]
9570     set allchildren($id) {}
9571     set arcnos($id) {}
9572     lappend seeds $id
9573     lappend allchildren($p) $id
9574     set a [incr nextarc]
9575     set arcstart($a) $id
9576     set archeads($a) {}
9577     set arctags($a) {}
9578     set arcids($a) [list $p]
9579     set arcend($a) $p
9580     if {![info exists arcout($p)]} {
9581         splitarc $p
9582     }
9583     lappend arcnos($p) $a
9584     set arcout($id) [list $a]
9585 }
9586
9587 # This implements a cache for the topology information.
9588 # The cache saves, for each arc, the start and end of the arc,
9589 # the ids on the arc, and the outgoing arcs from the end.
9590 proc readcache {f} {
9591     global arcnos arcids arcout arcstart arcend arctags archeads nextarc
9592     global idtags idheads allparents cachedarcs possible_seeds seeds growing
9593     global allcwait
9594
9595     set a $nextarc
9596     set lim $cachedarcs
9597     if {$lim - $a > 500} {
9598         set lim [expr {$a + 500}]
9599     }
9600     if {[catch {
9601         if {$a == $lim} {
9602             # finish reading the cache and setting up arctags, etc.
9603             set line [gets $f]
9604             if {$line ne "1"} {error "bad final version"}
9605             close $f
9606             foreach id [array names idtags] {
9607                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9608                     [llength $allparents($id)] == 1} {
9609                     set a [lindex $arcnos($id) 0]
9610                     if {$arctags($a) eq {}} {
9611                         recalcarc $a
9612                     }
9613                 }
9614             }
9615             foreach id [array names idheads] {
9616                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9617                     [llength $allparents($id)] == 1} {
9618                     set a [lindex $arcnos($id) 0]
9619                     if {$archeads($a) eq {}} {
9620                         recalcarc $a
9621                     }
9622                 }
9623             }
9624             foreach id [lsort -unique $possible_seeds] {
9625                 if {$arcnos($id) eq {}} {
9626                     lappend seeds $id
9627                 }
9628             }
9629             set allcwait 0
9630         } else {
9631             while {[incr a] <= $lim} {
9632                 set line [gets $f]
9633                 if {[llength $line] != 3} {error "bad line"}
9634                 set s [lindex $line 0]
9635                 set arcstart($a) $s
9636                 lappend arcout($s) $a
9637                 if {![info exists arcnos($s)]} {
9638                     lappend possible_seeds $s
9639                     set arcnos($s) {}
9640                 }
9641                 set e [lindex $line 1]
9642                 if {$e eq {}} {
9643                     set growing($a) 1
9644                 } else {
9645                     set arcend($a) $e
9646                     if {![info exists arcout($e)]} {
9647                         set arcout($e) {}
9648                     }
9649                 }
9650                 set arcids($a) [lindex $line 2]
9651                 foreach id $arcids($a) {
9652                     lappend allparents($s) $id
9653                     set s $id
9654                     lappend arcnos($id) $a
9655                 }
9656                 if {![info exists allparents($s)]} {
9657                     set allparents($s) {}
9658                 }
9659                 set arctags($a) {}
9660                 set archeads($a) {}
9661             }
9662             set nextarc [expr {$a - 1}]
9663         }
9664     } err]} {
9665         dropcache $err
9666         return 0
9667     }
9668     if {!$allcwait} {
9669         getallcommits
9670     }
9671     return $allcwait
9672 }
9673
9674 proc getcache {f} {
9675     global nextarc cachedarcs possible_seeds
9676
9677     if {[catch {
9678         set line [gets $f]
9679         if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
9680         # make sure it's an integer
9681         set cachedarcs [expr {int([lindex $line 1])}]
9682         if {$cachedarcs < 0} {error "bad number of arcs"}
9683         set nextarc 0
9684         set possible_seeds {}
9685         run readcache $f
9686     } err]} {
9687         dropcache $err
9688     }
9689     return 0
9690 }
9691
9692 proc dropcache {err} {
9693     global allcwait nextarc cachedarcs seeds
9694
9695     #puts "dropping cache ($err)"
9696     foreach v {arcnos arcout arcids arcstart arcend growing \
9697                    arctags archeads allparents allchildren} {
9698         global $v
9699         catch {unset $v}
9700     }
9701     set allcwait 0
9702     set nextarc 0
9703     set cachedarcs 0
9704     set seeds {}
9705     getallcommits
9706 }
9707
9708 proc writecache {f} {
9709     global cachearc cachedarcs allccache
9710     global arcstart arcend arcnos arcids arcout
9711
9712     set a $cachearc
9713     set lim $cachedarcs
9714     if {$lim - $a > 1000} {
9715         set lim [expr {$a + 1000}]
9716     }
9717     if {[catch {
9718         while {[incr a] <= $lim} {
9719             if {[info exists arcend($a)]} {
9720                 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
9721             } else {
9722                 puts $f [list $arcstart($a) {} $arcids($a)]
9723             }
9724         }
9725     } err]} {
9726         catch {close $f}
9727         catch {file delete $allccache}
9728         #puts "writing cache failed ($err)"
9729         return 0
9730     }
9731     set cachearc [expr {$a - 1}]
9732     if {$a > $cachedarcs} {
9733         puts $f "1"
9734         close $f
9735         return 0
9736     }
9737     return 1
9738 }
9739
9740 proc savecache {} {
9741     global nextarc cachedarcs cachearc allccache
9742
9743     if {$nextarc == $cachedarcs} return
9744     set cachearc 0
9745     set cachedarcs $nextarc
9746     catch {
9747         set f [open $allccache w]
9748         puts $f [list 1 $cachedarcs]
9749         run writecache $f
9750     }
9751 }
9752
9753 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
9754 # or 0 if neither is true.
9755 proc anc_or_desc {a b} {
9756     global arcout arcstart arcend arcnos cached_isanc
9757
9758     if {$arcnos($a) eq $arcnos($b)} {
9759         # Both are on the same arc(s); either both are the same BMP,
9760         # or if one is not a BMP, the other is also not a BMP or is
9761         # the BMP at end of the arc (and it only has 1 incoming arc).
9762         # Or both can be BMPs with no incoming arcs.
9763         if {$a eq $b || $arcnos($a) eq {}} {
9764             return 0
9765         }
9766         # assert {[llength $arcnos($a)] == 1}
9767         set arc [lindex $arcnos($a) 0]
9768         set i [lsearch -exact $arcids($arc) $a]
9769         set j [lsearch -exact $arcids($arc) $b]
9770         if {$i < 0 || $i > $j} {
9771             return 1
9772         } else {
9773             return -1
9774         }
9775     }
9776
9777     if {![info exists arcout($a)]} {
9778         set arc [lindex $arcnos($a) 0]
9779         if {[info exists arcend($arc)]} {
9780             set aend $arcend($arc)
9781         } else {
9782             set aend {}
9783         }
9784         set a $arcstart($arc)
9785     } else {
9786         set aend $a
9787     }
9788     if {![info exists arcout($b)]} {
9789         set arc [lindex $arcnos($b) 0]
9790         if {[info exists arcend($arc)]} {
9791             set bend $arcend($arc)
9792         } else {
9793             set bend {}
9794         }
9795         set b $arcstart($arc)
9796     } else {
9797         set bend $b
9798     }
9799     if {$a eq $bend} {
9800         return 1
9801     }
9802     if {$b eq $aend} {
9803         return -1
9804     }
9805     if {[info exists cached_isanc($a,$bend)]} {
9806         if {$cached_isanc($a,$bend)} {
9807             return 1
9808         }
9809     }
9810     if {[info exists cached_isanc($b,$aend)]} {
9811         if {$cached_isanc($b,$aend)} {
9812             return -1
9813         }
9814         if {[info exists cached_isanc($a,$bend)]} {
9815             return 0
9816         }
9817     }
9818
9819     set todo [list $a $b]
9820     set anc($a) a
9821     set anc($b) b
9822     for {set i 0} {$i < [llength $todo]} {incr i} {
9823         set x [lindex $todo $i]
9824         if {$anc($x) eq {}} {
9825             continue
9826         }
9827         foreach arc $arcnos($x) {
9828             set xd $arcstart($arc)
9829             if {$xd eq $bend} {
9830                 set cached_isanc($a,$bend) 1
9831                 set cached_isanc($b,$aend) 0
9832                 return 1
9833             } elseif {$xd eq $aend} {
9834                 set cached_isanc($b,$aend) 1
9835                 set cached_isanc($a,$bend) 0
9836                 return -1
9837             }
9838             if {![info exists anc($xd)]} {
9839                 set anc($xd) $anc($x)
9840                 lappend todo $xd
9841             } elseif {$anc($xd) ne $anc($x)} {
9842                 set anc($xd) {}
9843             }
9844         }
9845     }
9846     set cached_isanc($a,$bend) 0
9847     set cached_isanc($b,$aend) 0
9848     return 0
9849 }
9850
9851 # This identifies whether $desc has an ancestor that is
9852 # a growing tip of the graph and which is not an ancestor of $anc
9853 # and returns 0 if so and 1 if not.
9854 # If we subsequently discover a tag on such a growing tip, and that
9855 # turns out to be a descendent of $anc (which it could, since we
9856 # don't necessarily see children before parents), then $desc
9857 # isn't a good choice to display as a descendent tag of
9858 # $anc (since it is the descendent of another tag which is
9859 # a descendent of $anc).  Similarly, $anc isn't a good choice to
9860 # display as a ancestor tag of $desc.
9861 #
9862 proc is_certain {desc anc} {
9863     global arcnos arcout arcstart arcend growing problems
9864
9865     set certain {}
9866     if {[llength $arcnos($anc)] == 1} {
9867         # tags on the same arc are certain
9868         if {$arcnos($desc) eq $arcnos($anc)} {
9869             return 1
9870         }
9871         if {![info exists arcout($anc)]} {
9872             # if $anc is partway along an arc, use the start of the arc instead
9873             set a [lindex $arcnos($anc) 0]
9874             set anc $arcstart($a)
9875         }
9876     }
9877     if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
9878         set x $desc
9879     } else {
9880         set a [lindex $arcnos($desc) 0]
9881         set x $arcend($a)
9882     }
9883     if {$x == $anc} {
9884         return 1
9885     }
9886     set anclist [list $x]
9887     set dl($x) 1
9888     set nnh 1
9889     set ngrowanc 0
9890     for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
9891         set x [lindex $anclist $i]
9892         if {$dl($x)} {
9893             incr nnh -1
9894         }
9895         set done($x) 1
9896         foreach a $arcout($x) {
9897             if {[info exists growing($a)]} {
9898                 if {![info exists growanc($x)] && $dl($x)} {
9899                     set growanc($x) 1
9900                     incr ngrowanc
9901                 }
9902             } else {
9903                 set y $arcend($a)
9904                 if {[info exists dl($y)]} {
9905                     if {$dl($y)} {
9906                         if {!$dl($x)} {
9907                             set dl($y) 0
9908                             if {![info exists done($y)]} {
9909                                 incr nnh -1
9910                             }
9911                             if {[info exists growanc($x)]} {
9912                                 incr ngrowanc -1
9913                             }
9914                             set xl [list $y]
9915                             for {set k 0} {$k < [llength $xl]} {incr k} {
9916                                 set z [lindex $xl $k]
9917                                 foreach c $arcout($z) {
9918                                     if {[info exists arcend($c)]} {
9919                                         set v $arcend($c)
9920                                         if {[info exists dl($v)] && $dl($v)} {
9921                                             set dl($v) 0
9922                                             if {![info exists done($v)]} {
9923                                                 incr nnh -1
9924                                             }
9925                                             if {[info exists growanc($v)]} {
9926                                                 incr ngrowanc -1
9927                                             }
9928                                             lappend xl $v
9929                                         }
9930                                     }
9931                                 }
9932                             }
9933                         }
9934                     }
9935                 } elseif {$y eq $anc || !$dl($x)} {
9936                     set dl($y) 0
9937                     lappend anclist $y
9938                 } else {
9939                     set dl($y) 1
9940                     lappend anclist $y
9941                     incr nnh
9942                 }
9943             }
9944         }
9945     }
9946     foreach x [array names growanc] {
9947         if {$dl($x)} {
9948             return 0
9949         }
9950         return 0
9951     }
9952     return 1
9953 }
9954
9955 proc validate_arctags {a} {
9956     global arctags idtags
9957
9958     set i -1
9959     set na $arctags($a)
9960     foreach id $arctags($a) {
9961         incr i
9962         if {![info exists idtags($id)]} {
9963             set na [lreplace $na $i $i]
9964             incr i -1
9965         }
9966     }
9967     set arctags($a) $na
9968 }
9969
9970 proc validate_archeads {a} {
9971     global archeads idheads
9972
9973     set i -1
9974     set na $archeads($a)
9975     foreach id $archeads($a) {
9976         incr i
9977         if {![info exists idheads($id)]} {
9978             set na [lreplace $na $i $i]
9979             incr i -1
9980         }
9981     }
9982     set archeads($a) $na
9983 }
9984
9985 # Return the list of IDs that have tags that are descendents of id,
9986 # ignoring IDs that are descendents of IDs already reported.
9987 proc desctags {id} {
9988     global arcnos arcstart arcids arctags idtags allparents
9989     global growing cached_dtags
9990
9991     if {![info exists allparents($id)]} {
9992         return {}
9993     }
9994     set t1 [clock clicks -milliseconds]
9995     set argid $id
9996     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9997         # part-way along an arc; check that arc first
9998         set a [lindex $arcnos($id) 0]
9999         if {$arctags($a) ne {}} {
10000             validate_arctags $a
10001             set i [lsearch -exact $arcids($a) $id]
10002             set tid {}
10003             foreach t $arctags($a) {
10004                 set j [lsearch -exact $arcids($a) $t]
10005                 if {$j >= $i} break
10006                 set tid $t
10007             }
10008             if {$tid ne {}} {
10009                 return $tid
10010             }
10011         }
10012         set id $arcstart($a)
10013         if {[info exists idtags($id)]} {
10014             return $id
10015         }
10016     }
10017     if {[info exists cached_dtags($id)]} {
10018         return $cached_dtags($id)
10019     }
10020
10021     set origid $id
10022     set todo [list $id]
10023     set queued($id) 1
10024     set nc 1
10025     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10026         set id [lindex $todo $i]
10027         set done($id) 1
10028         set ta [info exists hastaggedancestor($id)]
10029         if {!$ta} {
10030             incr nc -1
10031         }
10032         # ignore tags on starting node
10033         if {!$ta && $i > 0} {
10034             if {[info exists idtags($id)]} {
10035                 set tagloc($id) $id
10036                 set ta 1
10037             } elseif {[info exists cached_dtags($id)]} {
10038                 set tagloc($id) $cached_dtags($id)
10039                 set ta 1
10040             }
10041         }
10042         foreach a $arcnos($id) {
10043             set d $arcstart($a)
10044             if {!$ta && $arctags($a) ne {}} {
10045                 validate_arctags $a
10046                 if {$arctags($a) ne {}} {
10047                     lappend tagloc($id) [lindex $arctags($a) end]
10048                 }
10049             }
10050             if {$ta || $arctags($a) ne {}} {
10051                 set tomark [list $d]
10052                 for {set j 0} {$j < [llength $tomark]} {incr j} {
10053                     set dd [lindex $tomark $j]
10054                     if {![info exists hastaggedancestor($dd)]} {
10055                         if {[info exists done($dd)]} {
10056                             foreach b $arcnos($dd) {
10057                                 lappend tomark $arcstart($b)
10058                             }
10059                             if {[info exists tagloc($dd)]} {
10060                                 unset tagloc($dd)
10061                             }
10062                         } elseif {[info exists queued($dd)]} {
10063                             incr nc -1
10064                         }
10065                         set hastaggedancestor($dd) 1
10066                     }
10067                 }
10068             }
10069             if {![info exists queued($d)]} {
10070                 lappend todo $d
10071                 set queued($d) 1
10072                 if {![info exists hastaggedancestor($d)]} {
10073                     incr nc
10074                 }
10075             }
10076         }
10077     }
10078     set tags {}
10079     foreach id [array names tagloc] {
10080         if {![info exists hastaggedancestor($id)]} {
10081             foreach t $tagloc($id) {
10082                 if {[lsearch -exact $tags $t] < 0} {
10083                     lappend tags $t
10084                 }
10085             }
10086         }
10087     }
10088     set t2 [clock clicks -milliseconds]
10089     set loopix $i
10090
10091     # remove tags that are descendents of other tags
10092     for {set i 0} {$i < [llength $tags]} {incr i} {
10093         set a [lindex $tags $i]
10094         for {set j 0} {$j < $i} {incr j} {
10095             set b [lindex $tags $j]
10096             set r [anc_or_desc $a $b]
10097             if {$r == 1} {
10098                 set tags [lreplace $tags $j $j]
10099                 incr j -1
10100                 incr i -1
10101             } elseif {$r == -1} {
10102                 set tags [lreplace $tags $i $i]
10103                 incr i -1
10104                 break
10105             }
10106         }
10107     }
10108
10109     if {[array names growing] ne {}} {
10110         # graph isn't finished, need to check if any tag could get
10111         # eclipsed by another tag coming later.  Simply ignore any
10112         # tags that could later get eclipsed.
10113         set ctags {}
10114         foreach t $tags {
10115             if {[is_certain $t $origid]} {
10116                 lappend ctags $t
10117             }
10118         }
10119         if {$tags eq $ctags} {
10120             set cached_dtags($origid) $tags
10121         } else {
10122             set tags $ctags
10123         }
10124     } else {
10125         set cached_dtags($origid) $tags
10126     }
10127     set t3 [clock clicks -milliseconds]
10128     if {0 && $t3 - $t1 >= 100} {
10129         puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10130             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10131     }
10132     return $tags
10133 }
10134
10135 proc anctags {id} {
10136     global arcnos arcids arcout arcend arctags idtags allparents
10137     global growing cached_atags
10138
10139     if {![info exists allparents($id)]} {
10140         return {}
10141     }
10142     set t1 [clock clicks -milliseconds]
10143     set argid $id
10144     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10145         # part-way along an arc; check that arc first
10146         set a [lindex $arcnos($id) 0]
10147         if {$arctags($a) ne {}} {
10148             validate_arctags $a
10149             set i [lsearch -exact $arcids($a) $id]
10150             foreach t $arctags($a) {
10151                 set j [lsearch -exact $arcids($a) $t]
10152                 if {$j > $i} {
10153                     return $t
10154                 }
10155             }
10156         }
10157         if {![info exists arcend($a)]} {
10158             return {}
10159         }
10160         set id $arcend($a)
10161         if {[info exists idtags($id)]} {
10162             return $id
10163         }
10164     }
10165     if {[info exists cached_atags($id)]} {
10166         return $cached_atags($id)
10167     }
10168
10169     set origid $id
10170     set todo [list $id]
10171     set queued($id) 1
10172     set taglist {}
10173     set nc 1
10174     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10175         set id [lindex $todo $i]
10176         set done($id) 1
10177         set td [info exists hastaggeddescendent($id)]
10178         if {!$td} {
10179             incr nc -1
10180         }
10181         # ignore tags on starting node
10182         if {!$td && $i > 0} {
10183             if {[info exists idtags($id)]} {
10184                 set tagloc($id) $id
10185                 set td 1
10186             } elseif {[info exists cached_atags($id)]} {
10187                 set tagloc($id) $cached_atags($id)
10188                 set td 1
10189             }
10190         }
10191         foreach a $arcout($id) {
10192             if {!$td && $arctags($a) ne {}} {
10193                 validate_arctags $a
10194                 if {$arctags($a) ne {}} {
10195                     lappend tagloc($id) [lindex $arctags($a) 0]
10196                 }
10197             }
10198             if {![info exists arcend($a)]} continue
10199             set d $arcend($a)
10200             if {$td || $arctags($a) ne {}} {
10201                 set tomark [list $d]
10202                 for {set j 0} {$j < [llength $tomark]} {incr j} {
10203                     set dd [lindex $tomark $j]
10204                     if {![info exists hastaggeddescendent($dd)]} {
10205                         if {[info exists done($dd)]} {
10206                             foreach b $arcout($dd) {
10207                                 if {[info exists arcend($b)]} {
10208                                     lappend tomark $arcend($b)
10209                                 }
10210                             }
10211                             if {[info exists tagloc($dd)]} {
10212                                 unset tagloc($dd)
10213                             }
10214                         } elseif {[info exists queued($dd)]} {
10215                             incr nc -1
10216                         }
10217                         set hastaggeddescendent($dd) 1
10218                     }
10219                 }
10220             }
10221             if {![info exists queued($d)]} {
10222                 lappend todo $d
10223                 set queued($d) 1
10224                 if {![info exists hastaggeddescendent($d)]} {
10225                     incr nc
10226                 }
10227             }
10228         }
10229     }
10230     set t2 [clock clicks -milliseconds]
10231     set loopix $i
10232     set tags {}
10233     foreach id [array names tagloc] {
10234         if {![info exists hastaggeddescendent($id)]} {
10235             foreach t $tagloc($id) {
10236                 if {[lsearch -exact $tags $t] < 0} {
10237                     lappend tags $t
10238                 }
10239             }
10240         }
10241     }
10242
10243     # remove tags that are ancestors of other tags
10244     for {set i 0} {$i < [llength $tags]} {incr i} {
10245         set a [lindex $tags $i]
10246         for {set j 0} {$j < $i} {incr j} {
10247             set b [lindex $tags $j]
10248             set r [anc_or_desc $a $b]
10249             if {$r == -1} {
10250                 set tags [lreplace $tags $j $j]
10251                 incr j -1
10252                 incr i -1
10253             } elseif {$r == 1} {
10254                 set tags [lreplace $tags $i $i]
10255                 incr i -1
10256                 break
10257             }
10258         }
10259     }
10260
10261     if {[array names growing] ne {}} {
10262         # graph isn't finished, need to check if any tag could get
10263         # eclipsed by another tag coming later.  Simply ignore any
10264         # tags that could later get eclipsed.
10265         set ctags {}
10266         foreach t $tags {
10267             if {[is_certain $origid $t]} {
10268                 lappend ctags $t
10269             }
10270         }
10271         if {$tags eq $ctags} {
10272             set cached_atags($origid) $tags
10273         } else {
10274             set tags $ctags
10275         }
10276     } else {
10277         set cached_atags($origid) $tags
10278     }
10279     set t3 [clock clicks -milliseconds]
10280     if {0 && $t3 - $t1 >= 100} {
10281         puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
10282             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10283     }
10284     return $tags
10285 }
10286
10287 # Return the list of IDs that have heads that are descendents of id,
10288 # including id itself if it has a head.
10289 proc descheads {id} {
10290     global arcnos arcstart arcids archeads idheads cached_dheads
10291     global allparents
10292
10293     if {![info exists allparents($id)]} {
10294         return {}
10295     }
10296     set aret {}
10297     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10298         # part-way along an arc; check it first
10299         set a [lindex $arcnos($id) 0]
10300         if {$archeads($a) ne {}} {
10301             validate_archeads $a
10302             set i [lsearch -exact $arcids($a) $id]
10303             foreach t $archeads($a) {
10304                 set j [lsearch -exact $arcids($a) $t]
10305                 if {$j > $i} break
10306                 lappend aret $t
10307             }
10308         }
10309         set id $arcstart($a)
10310     }
10311     set origid $id
10312     set todo [list $id]
10313     set seen($id) 1
10314     set ret {}
10315     for {set i 0} {$i < [llength $todo]} {incr i} {
10316         set id [lindex $todo $i]
10317         if {[info exists cached_dheads($id)]} {
10318             set ret [concat $ret $cached_dheads($id)]
10319         } else {
10320             if {[info exists idheads($id)]} {
10321                 lappend ret $id
10322             }
10323             foreach a $arcnos($id) {
10324                 if {$archeads($a) ne {}} {
10325                     validate_archeads $a
10326                     if {$archeads($a) ne {}} {
10327                         set ret [concat $ret $archeads($a)]
10328                     }
10329                 }
10330                 set d $arcstart($a)
10331                 if {![info exists seen($d)]} {
10332                     lappend todo $d
10333                     set seen($d) 1
10334                 }
10335             }
10336         }
10337     }
10338     set ret [lsort -unique $ret]
10339     set cached_dheads($origid) $ret
10340     return [concat $ret $aret]
10341 }
10342
10343 proc addedtag {id} {
10344     global arcnos arcout cached_dtags cached_atags
10345
10346     if {![info exists arcnos($id)]} return
10347     if {![info exists arcout($id)]} {
10348         recalcarc [lindex $arcnos($id) 0]
10349     }
10350     catch {unset cached_dtags}
10351     catch {unset cached_atags}
10352 }
10353
10354 proc addedhead {hid head} {
10355     global arcnos arcout cached_dheads
10356
10357     if {![info exists arcnos($hid)]} return
10358     if {![info exists arcout($hid)]} {
10359         recalcarc [lindex $arcnos($hid) 0]
10360     }
10361     catch {unset cached_dheads}
10362 }
10363
10364 proc removedhead {hid head} {
10365     global cached_dheads
10366
10367     catch {unset cached_dheads}
10368 }
10369
10370 proc movedhead {hid head} {
10371     global arcnos arcout cached_dheads
10372
10373     if {![info exists arcnos($hid)]} return
10374     if {![info exists arcout($hid)]} {
10375         recalcarc [lindex $arcnos($hid) 0]
10376     }
10377     catch {unset cached_dheads}
10378 }
10379
10380 proc changedrefs {} {
10381     global cached_dheads cached_dtags cached_atags
10382     global arctags archeads arcnos arcout idheads idtags
10383
10384     foreach id [concat [array names idheads] [array names idtags]] {
10385         if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
10386             set a [lindex $arcnos($id) 0]
10387             if {![info exists donearc($a)]} {
10388                 recalcarc $a
10389                 set donearc($a) 1
10390             }
10391         }
10392     }
10393     catch {unset cached_dtags}
10394     catch {unset cached_atags}
10395     catch {unset cached_dheads}
10396 }
10397
10398 proc rereadrefs {} {
10399     global idtags idheads idotherrefs mainheadid
10400
10401     set refids [concat [array names idtags] \
10402                     [array names idheads] [array names idotherrefs]]
10403     foreach id $refids {
10404         if {![info exists ref($id)]} {
10405             set ref($id) [listrefs $id]
10406         }
10407     }
10408     set oldmainhead $mainheadid
10409     readrefs
10410     changedrefs
10411     set refids [lsort -unique [concat $refids [array names idtags] \
10412                         [array names idheads] [array names idotherrefs]]]
10413     foreach id $refids {
10414         set v [listrefs $id]
10415         if {![info exists ref($id)] || $ref($id) != $v} {
10416             redrawtags $id
10417         }
10418     }
10419     if {$oldmainhead ne $mainheadid} {
10420         redrawtags $oldmainhead
10421         redrawtags $mainheadid
10422     }
10423     run refill_reflist
10424 }
10425
10426 proc listrefs {id} {
10427     global idtags idheads idotherrefs
10428
10429     set x {}
10430     if {[info exists idtags($id)]} {
10431         set x $idtags($id)
10432     }
10433     set y {}
10434     if {[info exists idheads($id)]} {
10435         set y $idheads($id)
10436     }
10437     set z {}
10438     if {[info exists idotherrefs($id)]} {
10439         set z $idotherrefs($id)
10440     }
10441     return [list $x $y $z]
10442 }
10443
10444 proc showtag {tag isnew} {
10445     global ctext tagcontents tagids linknum tagobjid
10446
10447     if {$isnew} {
10448         addtohistory [list showtag $tag 0] savectextpos
10449     }
10450     $ctext conf -state normal
10451     clear_ctext
10452     settabs 0
10453     set linknum 0
10454     if {![info exists tagcontents($tag)]} {
10455         catch {
10456             set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
10457         }
10458     }
10459     if {[info exists tagcontents($tag)]} {
10460         set text $tagcontents($tag)
10461     } else {
10462         set text "[mc "Tag"]: $tag\n[mc "Id"]:  $tagids($tag)"
10463     }
10464     appendwithlinks $text {}
10465     maybe_scroll_ctext
10466     $ctext conf -state disabled
10467     init_flist {}
10468 }
10469
10470 proc doquit {} {
10471     global stopped
10472     global gitktmpdir
10473
10474     set stopped 100
10475     savestuff .
10476     destroy .
10477
10478     if {[info exists gitktmpdir]} {
10479         catch {file delete -force $gitktmpdir}
10480     }
10481 }
10482
10483 proc mkfontdisp {font top which} {
10484     global fontattr fontpref $font NS use_ttk
10485
10486     set fontpref($font) [set $font]
10487     ${NS}::button $top.${font}but -text $which \
10488         -command [list choosefont $font $which]
10489     if {!$use_ttk} {$top.${font}but configure  -font optionfont}
10490     ${NS}::label $top.$font -relief flat -font $font \
10491         -text $fontattr($font,family) -justify left
10492     grid x $top.${font}but $top.$font -sticky w
10493 }
10494
10495 proc choosefont {font which} {
10496     global fontparam fontlist fonttop fontattr
10497     global prefstop NS
10498
10499     set fontparam(which) $which
10500     set fontparam(font) $font
10501     set fontparam(family) [font actual $font -family]
10502     set fontparam(size) $fontattr($font,size)
10503     set fontparam(weight) $fontattr($font,weight)
10504     set fontparam(slant) $fontattr($font,slant)
10505     set top .gitkfont
10506     set fonttop $top
10507     if {![winfo exists $top]} {
10508         font create sample
10509         eval font config sample [font actual $font]
10510         ttk_toplevel $top
10511         make_transient $top $prefstop
10512         wm title $top [mc "Gitk font chooser"]
10513         ${NS}::label $top.l -textvariable fontparam(which)
10514         pack $top.l -side top
10515         set fontlist [lsort [font families]]
10516         ${NS}::frame $top.f
10517         listbox $top.f.fam -listvariable fontlist \
10518             -yscrollcommand [list $top.f.sb set]
10519         bind $top.f.fam <<ListboxSelect>> selfontfam
10520         ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
10521         pack $top.f.sb -side right -fill y
10522         pack $top.f.fam -side left -fill both -expand 1
10523         pack $top.f -side top -fill both -expand 1
10524         ${NS}::frame $top.g
10525         spinbox $top.g.size -from 4 -to 40 -width 4 \
10526             -textvariable fontparam(size) \
10527             -validatecommand {string is integer -strict %s}
10528         checkbutton $top.g.bold -padx 5 \
10529             -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
10530             -variable fontparam(weight) -onvalue bold -offvalue normal
10531         checkbutton $top.g.ital -padx 5 \
10532             -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
10533             -variable fontparam(slant) -onvalue italic -offvalue roman
10534         pack $top.g.size $top.g.bold $top.g.ital -side left
10535         pack $top.g -side top
10536         canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
10537             -background white
10538         $top.c create text 100 25 -anchor center -text $which -font sample \
10539             -fill black -tags text
10540         bind $top.c <Configure> [list centertext $top.c]
10541         pack $top.c -side top -fill x
10542         ${NS}::frame $top.buts
10543         ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
10544         ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
10545         bind $top <Key-Return> fontok
10546         bind $top <Key-Escape> fontcan
10547         grid $top.buts.ok $top.buts.can
10548         grid columnconfigure $top.buts 0 -weight 1 -uniform a
10549         grid columnconfigure $top.buts 1 -weight 1 -uniform a
10550         pack $top.buts -side bottom -fill x
10551         trace add variable fontparam write chg_fontparam
10552     } else {
10553         raise $top
10554         $top.c itemconf text -text $which
10555     }
10556     set i [lsearch -exact $fontlist $fontparam(family)]
10557     if {$i >= 0} {
10558         $top.f.fam selection set $i
10559         $top.f.fam see $i
10560     }
10561 }
10562
10563 proc centertext {w} {
10564     $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
10565 }
10566
10567 proc fontok {} {
10568     global fontparam fontpref prefstop
10569
10570     set f $fontparam(font)
10571     set fontpref($f) [list $fontparam(family) $fontparam(size)]
10572     if {$fontparam(weight) eq "bold"} {
10573         lappend fontpref($f) "bold"
10574     }
10575     if {$fontparam(slant) eq "italic"} {
10576         lappend fontpref($f) "italic"
10577     }
10578     set w $prefstop.$f
10579     $w conf -text $fontparam(family) -font $fontpref($f)
10580
10581     fontcan
10582 }
10583
10584 proc fontcan {} {
10585     global fonttop fontparam
10586
10587     if {[info exists fonttop]} {
10588         catch {destroy $fonttop}
10589         catch {font delete sample}
10590         unset fonttop
10591         unset fontparam
10592     }
10593 }
10594
10595 if {[package vsatisfies [package provide Tk] 8.6]} {
10596     # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
10597     # function to make use of it.
10598     proc choosefont {font which} {
10599         tk fontchooser configure -title $which -font $font \
10600             -command [list on_choosefont $font $which]
10601         tk fontchooser show
10602     }
10603     proc on_choosefont {font which newfont} {
10604         global fontparam
10605         puts stderr "$font $newfont"
10606         array set f [font actual $newfont]
10607         set fontparam(which) $which
10608         set fontparam(font) $font
10609         set fontparam(family) $f(-family)
10610         set fontparam(size) $f(-size)
10611         set fontparam(weight) $f(-weight)
10612         set fontparam(slant) $f(-slant)
10613         fontok
10614     }
10615 }
10616
10617 proc selfontfam {} {
10618     global fonttop fontparam
10619
10620     set i [$fonttop.f.fam curselection]
10621     if {$i ne {}} {
10622         set fontparam(family) [$fonttop.f.fam get $i]
10623     }
10624 }
10625
10626 proc chg_fontparam {v sub op} {
10627     global fontparam
10628
10629     font config sample -$sub $fontparam($sub)
10630 }
10631
10632 proc doprefs {} {
10633     global maxwidth maxgraphpct use_ttk NS
10634     global oldprefs prefstop showneartags showlocalchanges
10635     global bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
10636     global tabstop limitdiffs autoselect extdifftool perfile_attrs
10637     global hideremotes want_ttk have_ttk
10638
10639     set top .gitkprefs
10640     set prefstop $top
10641     if {[winfo exists $top]} {
10642         raise $top
10643         return
10644     }
10645     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
10646                    limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
10647         set oldprefs($v) [set $v]
10648     }
10649     ttk_toplevel $top
10650     wm title $top [mc "Gitk preferences"]
10651     make_transient $top .
10652     ${NS}::label $top.ldisp -text [mc "Commit list display options"]
10653     grid $top.ldisp - -sticky w -pady 10
10654     ${NS}::label $top.spacer -text " "
10655     ${NS}::label $top.maxwidthl -text [mc "Maximum graph width (lines)"]
10656     spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
10657     grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
10658     ${NS}::label $top.maxpctl -text [mc "Maximum graph width (% of pane)"]
10659     spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
10660     grid x $top.maxpctl $top.maxpct -sticky w
10661     ${NS}::checkbutton $top.showlocal -text [mc "Show local changes"] \
10662         -variable showlocalchanges
10663     grid x $top.showlocal -sticky w
10664     ${NS}::checkbutton $top.autoselect -text [mc "Auto-select SHA1"] \
10665         -variable autoselect
10666     grid x $top.autoselect -sticky w
10667     ${NS}::checkbutton $top.hideremotes -text [mc "Hide remote refs"] \
10668         -variable hideremotes
10669     grid x $top.hideremotes -sticky w
10670
10671     ${NS}::label $top.ddisp -text [mc "Diff display options"]
10672     grid $top.ddisp - -sticky w -pady 10
10673     ${NS}::label $top.tabstopl -text [mc "Tab spacing"]
10674     spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
10675     grid x $top.tabstopl $top.tabstop -sticky w
10676     ${NS}::checkbutton $top.ntag -text [mc "Display nearby tags"] \
10677         -variable showneartags
10678     grid x $top.ntag -sticky w
10679     ${NS}::checkbutton $top.ldiff -text [mc "Limit diffs to listed paths"] \
10680         -variable limitdiffs
10681     grid x $top.ldiff -sticky w
10682     ${NS}::checkbutton $top.lattr -text [mc "Support per-file encodings"] \
10683         -variable perfile_attrs
10684     grid x $top.lattr -sticky w
10685
10686     ${NS}::entry $top.extdifft -textvariable extdifftool
10687     ${NS}::frame $top.extdifff
10688     ${NS}::label $top.extdifff.l -text [mc "External diff tool" ]
10689     ${NS}::button $top.extdifff.b -text [mc "Choose..."] -command choose_extdiff
10690     pack $top.extdifff.l $top.extdifff.b -side left
10691     pack configure $top.extdifff.l -padx 10
10692     grid x $top.extdifff $top.extdifft -sticky ew
10693
10694     ${NS}::label $top.lgen -text [mc "General options"]
10695     grid $top.lgen - -sticky w -pady 10
10696     ${NS}::checkbutton $top.want_ttk -variable want_ttk \
10697         -text [mc "Use themed widgets"]
10698     if {$have_ttk} {
10699         ${NS}::label $top.ttk_note -text [mc "(change requires restart)"]
10700     } else {
10701         ${NS}::label $top.ttk_note -text [mc "(currently unavailable)"]
10702     }
10703     grid x $top.want_ttk $top.ttk_note -sticky w
10704
10705     ${NS}::label $top.cdisp -text [mc "Colors: press to choose"]
10706     grid $top.cdisp - -sticky w -pady 10
10707     label $top.bg -padx 40 -relief sunk -background $bgcolor
10708     ${NS}::button $top.bgbut -text [mc "Background"] \
10709         -command [list choosecolor bgcolor {} $top.bg [mc "background"] setbg]
10710     grid x $top.bgbut $top.bg -sticky w
10711     label $top.fg -padx 40 -relief sunk -background $fgcolor
10712     ${NS}::button $top.fgbut -text [mc "Foreground"] \
10713         -command [list choosecolor fgcolor {} $top.fg [mc "foreground"] setfg]
10714     grid x $top.fgbut $top.fg -sticky w
10715     label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
10716     ${NS}::button $top.diffoldbut -text [mc "Diff: old lines"] \
10717         -command [list choosecolor diffcolors 0 $top.diffold [mc "diff old lines"] \
10718                       [list $ctext tag conf d0 -foreground]]
10719     grid x $top.diffoldbut $top.diffold -sticky w
10720     label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
10721     ${NS}::button $top.diffnewbut -text [mc "Diff: new lines"] \
10722         -command [list choosecolor diffcolors 1 $top.diffnew [mc "diff new lines"] \
10723                       [list $ctext tag conf dresult -foreground]]
10724     grid x $top.diffnewbut $top.diffnew -sticky w
10725     label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
10726     ${NS}::button $top.hunksepbut -text [mc "Diff: hunk header"] \
10727         -command [list choosecolor diffcolors 2 $top.hunksep \
10728                       [mc "diff hunk header"] \
10729                       [list $ctext tag conf hunksep -foreground]]
10730     grid x $top.hunksepbut $top.hunksep -sticky w
10731     label $top.markbgsep -padx 40 -relief sunk -background $markbgcolor
10732     ${NS}::button $top.markbgbut -text [mc "Marked line bg"] \
10733         -command [list choosecolor markbgcolor {} $top.markbgsep \
10734                       [mc "marked line background"] \
10735                       [list $ctext tag conf omark -background]]
10736     grid x $top.markbgbut $top.markbgsep -sticky w
10737     label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
10738     ${NS}::button $top.selbgbut -text [mc "Select bg"] \
10739         -command [list choosecolor selectbgcolor {} $top.selbgsep [mc "background"] setselbg]
10740     grid x $top.selbgbut $top.selbgsep -sticky w
10741
10742     ${NS}::label $top.cfont -text [mc "Fonts: press to choose"]
10743     grid $top.cfont - -sticky w -pady 10
10744     mkfontdisp mainfont $top [mc "Main font"]
10745     mkfontdisp textfont $top [mc "Diff display font"]
10746     mkfontdisp uifont $top [mc "User interface font"]
10747
10748     if {!$use_ttk} {
10749         foreach w {maxpctl maxwidthl showlocal autoselect tabstopl ntag
10750             ldiff lattr extdifff.l extdifff.b bgbut fgbut
10751             diffoldbut diffnewbut hunksepbut markbgbut selbgbut
10752             want_ttk ttk_note} {
10753             $top.$w configure -font optionfont
10754         }
10755     }
10756
10757     ${NS}::frame $top.buts
10758     ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
10759     ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
10760     bind $top <Key-Return> prefsok
10761     bind $top <Key-Escape> prefscan
10762     grid $top.buts.ok $top.buts.can
10763     grid columnconfigure $top.buts 0 -weight 1 -uniform a
10764     grid columnconfigure $top.buts 1 -weight 1 -uniform a
10765     grid $top.buts - - -pady 10 -sticky ew
10766     grid columnconfigure $top 2 -weight 1
10767     bind $top <Visibility> "focus $top.buts.ok"
10768 }
10769
10770 proc choose_extdiff {} {
10771     global extdifftool
10772
10773     set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
10774     if {$prog ne {}} {
10775         set extdifftool $prog
10776     }
10777 }
10778
10779 proc choosecolor {v vi w x cmd} {
10780     global $v
10781
10782     set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
10783                -title [mc "Gitk: choose color for %s" $x]]
10784     if {$c eq {}} return
10785     $w conf -background $c
10786     lset $v $vi $c
10787     eval $cmd $c
10788 }
10789
10790 proc setselbg {c} {
10791     global bglist cflist
10792     foreach w $bglist {
10793         $w configure -selectbackground $c
10794     }
10795     $cflist tag configure highlight \
10796         -background [$cflist cget -selectbackground]
10797     allcanvs itemconf secsel -fill $c
10798 }
10799
10800 proc setbg {c} {
10801     global bglist
10802
10803     foreach w $bglist {
10804         $w conf -background $c
10805     }
10806 }
10807
10808 proc setfg {c} {
10809     global fglist canv
10810
10811     foreach w $fglist {
10812         $w conf -foreground $c
10813     }
10814     allcanvs itemconf text -fill $c
10815     $canv itemconf circle -outline $c
10816     $canv itemconf markid -outline $c
10817 }
10818
10819 proc prefscan {} {
10820     global oldprefs prefstop
10821
10822     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
10823                    limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
10824         global $v
10825         set $v $oldprefs($v)
10826     }
10827     catch {destroy $prefstop}
10828     unset prefstop
10829     fontcan
10830 }
10831
10832 proc prefsok {} {
10833     global maxwidth maxgraphpct
10834     global oldprefs prefstop showneartags showlocalchanges
10835     global fontpref mainfont textfont uifont
10836     global limitdiffs treediffs perfile_attrs
10837     global hideremotes
10838
10839     catch {destroy $prefstop}
10840     unset prefstop
10841     fontcan
10842     set fontchanged 0
10843     if {$mainfont ne $fontpref(mainfont)} {
10844         set mainfont $fontpref(mainfont)
10845         parsefont mainfont $mainfont
10846         eval font configure mainfont [fontflags mainfont]
10847         eval font configure mainfontbold [fontflags mainfont 1]
10848         setcoords
10849         set fontchanged 1
10850     }
10851     if {$textfont ne $fontpref(textfont)} {
10852         set textfont $fontpref(textfont)
10853         parsefont textfont $textfont
10854         eval font configure textfont [fontflags textfont]
10855         eval font configure textfontbold [fontflags textfont 1]
10856     }
10857     if {$uifont ne $fontpref(uifont)} {
10858         set uifont $fontpref(uifont)
10859         parsefont uifont $uifont
10860         eval font configure uifont [fontflags uifont]
10861     }
10862     settabs
10863     if {$showlocalchanges != $oldprefs(showlocalchanges)} {
10864         if {$showlocalchanges} {
10865             doshowlocalchanges
10866         } else {
10867             dohidelocalchanges
10868         }
10869     }
10870     if {$limitdiffs != $oldprefs(limitdiffs) ||
10871         ($perfile_attrs && !$oldprefs(perfile_attrs))} {
10872         # treediffs elements are limited by path;
10873         # won't have encodings cached if perfile_attrs was just turned on
10874         catch {unset treediffs}
10875     }
10876     if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
10877         || $maxgraphpct != $oldprefs(maxgraphpct)} {
10878         redisplay
10879     } elseif {$showneartags != $oldprefs(showneartags) ||
10880           $limitdiffs != $oldprefs(limitdiffs)} {
10881         reselectline
10882     }
10883     if {$hideremotes != $oldprefs(hideremotes)} {
10884         rereadrefs
10885     }
10886 }
10887
10888 proc formatdate {d} {
10889     global datetimeformat
10890     if {$d ne {}} {
10891         set d [clock format $d -format $datetimeformat]
10892     }
10893     return $d
10894 }
10895
10896 # This list of encoding names and aliases is distilled from
10897 # http://www.iana.org/assignments/character-sets.
10898 # Not all of them are supported by Tcl.
10899 set encoding_aliases {
10900     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
10901       ISO646-US US-ASCII us IBM367 cp367 csASCII }
10902     { ISO-10646-UTF-1 csISO10646UTF1 }
10903     { ISO_646.basic:1983 ref csISO646basic1983 }
10904     { INVARIANT csINVARIANT }
10905     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
10906     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
10907     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
10908     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
10909     { NATS-DANO iso-ir-9-1 csNATSDANO }
10910     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
10911     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
10912     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
10913     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
10914     { ISO-2022-KR csISO2022KR }
10915     { EUC-KR csEUCKR }
10916     { ISO-2022-JP csISO2022JP }
10917     { ISO-2022-JP-2 csISO2022JP2 }
10918     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
10919       csISO13JISC6220jp }
10920     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
10921     { IT iso-ir-15 ISO646-IT csISO15Italian }
10922     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
10923     { ES iso-ir-17 ISO646-ES csISO17Spanish }
10924     { greek7-old iso-ir-18 csISO18Greek7Old }
10925     { latin-greek iso-ir-19 csISO19LatinGreek }
10926     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
10927     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
10928     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
10929     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
10930     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
10931     { BS_viewdata iso-ir-47 csISO47BSViewdata }
10932     { INIS iso-ir-49 csISO49INIS }
10933     { INIS-8 iso-ir-50 csISO50INIS8 }
10934     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
10935     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
10936     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
10937     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
10938     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
10939     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
10940       csISO60Norwegian1 }
10941     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
10942     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
10943     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
10944     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
10945     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
10946     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
10947     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
10948     { greek7 iso-ir-88 csISO88Greek7 }
10949     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
10950     { iso-ir-90 csISO90 }
10951     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
10952     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
10953       csISO92JISC62991984b }
10954     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
10955     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
10956     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
10957       csISO95JIS62291984handadd }
10958     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
10959     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
10960     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
10961     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
10962       CP819 csISOLatin1 }
10963     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
10964     { T.61-7bit iso-ir-102 csISO102T617bit }
10965     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
10966     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
10967     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
10968     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
10969     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
10970     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
10971     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
10972     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
10973       arabic csISOLatinArabic }
10974     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
10975     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
10976     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
10977       greek greek8 csISOLatinGreek }
10978     { T.101-G2 iso-ir-128 csISO128T101G2 }
10979     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
10980       csISOLatinHebrew }
10981     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
10982     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
10983     { CSN_369103 iso-ir-139 csISO139CSN369103 }
10984     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
10985     { ISO_6937-2-add iso-ir-142 csISOTextComm }
10986     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
10987     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
10988       csISOLatinCyrillic }
10989     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
10990     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
10991     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
10992     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
10993     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
10994     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
10995     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
10996     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
10997     { ISO_10367-box iso-ir-155 csISO10367Box }
10998     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
10999     { latin-lap lap iso-ir-158 csISO158Lap }
11000     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
11001     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
11002     { us-dk csUSDK }
11003     { dk-us csDKUS }
11004     { JIS_X0201 X0201 csHalfWidthKatakana }
11005     { KSC5636 ISO646-KR csKSC5636 }
11006     { ISO-10646-UCS-2 csUnicode }
11007     { ISO-10646-UCS-4 csUCS4 }
11008     { DEC-MCS dec csDECMCS }
11009     { hp-roman8 roman8 r8 csHPRoman8 }
11010     { macintosh mac csMacintosh }
11011     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
11012       csIBM037 }
11013     { IBM038 EBCDIC-INT cp038 csIBM038 }
11014     { IBM273 CP273 csIBM273 }
11015     { IBM274 EBCDIC-BE CP274 csIBM274 }
11016     { IBM275 EBCDIC-BR cp275 csIBM275 }
11017     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
11018     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
11019     { IBM280 CP280 ebcdic-cp-it csIBM280 }
11020     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
11021     { IBM284 CP284 ebcdic-cp-es csIBM284 }
11022     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
11023     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
11024     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
11025     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
11026     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
11027     { IBM424 cp424 ebcdic-cp-he csIBM424 }
11028     { IBM437 cp437 437 csPC8CodePage437 }
11029     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
11030     { IBM775 cp775 csPC775Baltic }
11031     { IBM850 cp850 850 csPC850Multilingual }
11032     { IBM851 cp851 851 csIBM851 }
11033     { IBM852 cp852 852 csPCp852 }
11034     { IBM855 cp855 855 csIBM855 }
11035     { IBM857 cp857 857 csIBM857 }
11036     { IBM860 cp860 860 csIBM860 }
11037     { IBM861 cp861 861 cp-is csIBM861 }
11038     { IBM862 cp862 862 csPC862LatinHebrew }
11039     { IBM863 cp863 863 csIBM863 }
11040     { IBM864 cp864 csIBM864 }
11041     { IBM865 cp865 865 csIBM865 }
11042     { IBM866 cp866 866 csIBM866 }
11043     { IBM868 CP868 cp-ar csIBM868 }
11044     { IBM869 cp869 869 cp-gr csIBM869 }
11045     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
11046     { IBM871 CP871 ebcdic-cp-is csIBM871 }
11047     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
11048     { IBM891 cp891 csIBM891 }
11049     { IBM903 cp903 csIBM903 }
11050     { IBM904 cp904 904 csIBBM904 }
11051     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
11052     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
11053     { IBM1026 CP1026 csIBM1026 }
11054     { EBCDIC-AT-DE csIBMEBCDICATDE }
11055     { EBCDIC-AT-DE-A csEBCDICATDEA }
11056     { EBCDIC-CA-FR csEBCDICCAFR }
11057     { EBCDIC-DK-NO csEBCDICDKNO }
11058     { EBCDIC-DK-NO-A csEBCDICDKNOA }
11059     { EBCDIC-FI-SE csEBCDICFISE }
11060     { EBCDIC-FI-SE-A csEBCDICFISEA }
11061     { EBCDIC-FR csEBCDICFR }
11062     { EBCDIC-IT csEBCDICIT }
11063     { EBCDIC-PT csEBCDICPT }
11064     { EBCDIC-ES csEBCDICES }
11065     { EBCDIC-ES-A csEBCDICESA }
11066     { EBCDIC-ES-S csEBCDICESS }
11067     { EBCDIC-UK csEBCDICUK }
11068     { EBCDIC-US csEBCDICUS }
11069     { UNKNOWN-8BIT csUnknown8BiT }
11070     { MNEMONIC csMnemonic }
11071     { MNEM csMnem }
11072     { VISCII csVISCII }
11073     { VIQR csVIQR }
11074     { KOI8-R csKOI8R }
11075     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
11076     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
11077     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
11078     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
11079     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
11080     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
11081     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
11082     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
11083     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
11084     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
11085     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
11086     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
11087     { IBM1047 IBM-1047 }
11088     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
11089     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
11090     { UNICODE-1-1 csUnicode11 }
11091     { CESU-8 csCESU-8 }
11092     { BOCU-1 csBOCU-1 }
11093     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
11094     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
11095       l8 }
11096     { ISO-8859-15 ISO_8859-15 Latin-9 }
11097     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
11098     { GBK CP936 MS936 windows-936 }
11099     { JIS_Encoding csJISEncoding }
11100     { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
11101     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
11102       EUC-JP }
11103     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
11104     { ISO-10646-UCS-Basic csUnicodeASCII }
11105     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
11106     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
11107     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
11108     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
11109     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
11110     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
11111     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
11112     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
11113     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
11114     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
11115     { Adobe-Standard-Encoding csAdobeStandardEncoding }
11116     { Ventura-US csVenturaUS }
11117     { Ventura-International csVenturaInternational }
11118     { PC8-Danish-Norwegian csPC8DanishNorwegian }
11119     { PC8-Turkish csPC8Turkish }
11120     { IBM-Symbols csIBMSymbols }
11121     { IBM-Thai csIBMThai }
11122     { HP-Legal csHPLegal }
11123     { HP-Pi-font csHPPiFont }
11124     { HP-Math8 csHPMath8 }
11125     { Adobe-Symbol-Encoding csHPPSMath }
11126     { HP-DeskTop csHPDesktop }
11127     { Ventura-Math csVenturaMath }
11128     { Microsoft-Publishing csMicrosoftPublishing }
11129     { Windows-31J csWindows31J }
11130     { GB2312 csGB2312 }
11131     { Big5 csBig5 }
11132 }
11133
11134 proc tcl_encoding {enc} {
11135     global encoding_aliases tcl_encoding_cache
11136     if {[info exists tcl_encoding_cache($enc)]} {
11137         return $tcl_encoding_cache($enc)
11138     }
11139     set names [encoding names]
11140     set lcnames [string tolower $names]
11141     set enc [string tolower $enc]
11142     set i [lsearch -exact $lcnames $enc]
11143     if {$i < 0} {
11144         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
11145         if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
11146             set i [lsearch -exact $lcnames $encx]
11147         }
11148     }
11149     if {$i < 0} {
11150         foreach l $encoding_aliases {
11151             set ll [string tolower $l]
11152             if {[lsearch -exact $ll $enc] < 0} continue
11153             # look through the aliases for one that tcl knows about
11154             foreach e $ll {
11155                 set i [lsearch -exact $lcnames $e]
11156                 if {$i < 0} {
11157                     if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
11158                         set i [lsearch -exact $lcnames $ex]
11159                     }
11160                 }
11161                 if {$i >= 0} break
11162             }
11163             break
11164         }
11165     }
11166     set tclenc {}
11167     if {$i >= 0} {
11168         set tclenc [lindex $names $i]
11169     }
11170     set tcl_encoding_cache($enc) $tclenc
11171     return $tclenc
11172 }
11173
11174 proc gitattr {path attr default} {
11175     global path_attr_cache
11176     if {[info exists path_attr_cache($attr,$path)]} {
11177         set r $path_attr_cache($attr,$path)
11178     } else {
11179         set r "unspecified"
11180         if {![catch {set line [exec git check-attr $attr -- $path]}]} {
11181             regexp "(.*): $attr: (.*)" $line m f r
11182         }
11183         set path_attr_cache($attr,$path) $r
11184     }
11185     if {$r eq "unspecified"} {
11186         return $default
11187     }
11188     return $r
11189 }
11190
11191 proc cache_gitattr {attr pathlist} {
11192     global path_attr_cache
11193     set newlist {}
11194     foreach path $pathlist {
11195         if {![info exists path_attr_cache($attr,$path)]} {
11196             lappend newlist $path
11197         }
11198     }
11199     set lim 1000
11200     if {[tk windowingsystem] == "win32"} {
11201         # windows has a 32k limit on the arguments to a command...
11202         set lim 30
11203     }
11204     while {$newlist ne {}} {
11205         set head [lrange $newlist 0 [expr {$lim - 1}]]
11206         set newlist [lrange $newlist $lim end]
11207         if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
11208             foreach row [split $rlist "\n"] {
11209                 if {[regexp "(.*): $attr: (.*)" $row m path value]} {
11210                     if {[string index $path 0] eq "\""} {
11211                         set path [encoding convertfrom [lindex $path 0]]
11212                     }
11213                     set path_attr_cache($attr,$path) $value
11214                 }
11215             }
11216         }
11217     }
11218 }
11219
11220 proc get_path_encoding {path} {
11221     global gui_encoding perfile_attrs
11222     set tcl_enc $gui_encoding
11223     if {$path ne {} && $perfile_attrs} {
11224         set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
11225         if {$enc2 ne {}} {
11226             set tcl_enc $enc2
11227         }
11228     }
11229     return $tcl_enc
11230 }
11231
11232 # First check that Tcl/Tk is recent enough
11233 if {[catch {package require Tk 8.4} err]} {
11234     show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
11235                      Gitk requires at least Tcl/Tk 8.4."]
11236     exit 1
11237 }
11238
11239 # defaults...
11240 set wrcomcmd "git diff-tree --stdin -p --pretty"
11241
11242 set gitencoding {}
11243 catch {
11244     set gitencoding [exec git config --get i18n.commitencoding]
11245 }
11246 catch {
11247     set gitencoding [exec git config --get i18n.logoutputencoding]
11248 }
11249 if {$gitencoding == ""} {
11250     set gitencoding "utf-8"
11251 }
11252 set tclencoding [tcl_encoding $gitencoding]
11253 if {$tclencoding == {}} {
11254     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
11255 }
11256
11257 set gui_encoding [encoding system]
11258 catch {
11259     set enc [exec git config --get gui.encoding]
11260     if {$enc ne {}} {
11261         set tclenc [tcl_encoding $enc]
11262         if {$tclenc ne {}} {
11263             set gui_encoding $tclenc
11264         } else {
11265             puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
11266         }
11267     }
11268 }
11269
11270 if {[tk windowingsystem] eq "aqua"} {
11271     set mainfont {{Lucida Grande} 9}
11272     set textfont {Monaco 9}
11273     set uifont {{Lucida Grande} 9 bold}
11274 } else {
11275     set mainfont {Helvetica 9}
11276     set textfont {Courier 9}
11277     set uifont {Helvetica 9 bold}
11278 }
11279 set tabstop 8
11280 set findmergefiles 0
11281 set maxgraphpct 50
11282 set maxwidth 16
11283 set revlistorder 0
11284 set fastdate 0
11285 set uparrowlen 5
11286 set downarrowlen 5
11287 set mingaplen 100
11288 set cmitmode "patch"
11289 set wrapcomment "none"
11290 set showneartags 1
11291 set hideremotes 0
11292 set maxrefs 20
11293 set maxlinelen 200
11294 set showlocalchanges 1
11295 set limitdiffs 1
11296 set datetimeformat "%Y-%m-%d %H:%M:%S"
11297 set autoselect 1
11298 set perfile_attrs 0
11299 set want_ttk 1
11300
11301 if {[tk windowingsystem] eq "aqua"} {
11302     set extdifftool "opendiff"
11303 } else {
11304     set extdifftool "meld"
11305 }
11306
11307 set colors {green red blue magenta darkgrey brown orange}
11308 set bgcolor white
11309 set fgcolor black
11310 set diffcolors {red "#00a000" blue}
11311 set diffcontext 3
11312 set ignorespace 0
11313 set selectbgcolor gray85
11314 set markbgcolor "#e0e0ff"
11315
11316 set circlecolors {white blue gray blue blue}
11317
11318 # button for popping up context menus
11319 if {[tk windowingsystem] eq "aqua"} {
11320     set ctxbut <Button-2>
11321 } else {
11322     set ctxbut <Button-3>
11323 }
11324
11325 ## For msgcat loading, first locate the installation location.
11326 if { [info exists ::env(GITK_MSGSDIR)] } {
11327     ## Msgsdir was manually set in the environment.
11328     set gitk_msgsdir $::env(GITK_MSGSDIR)
11329 } else {
11330     ## Let's guess the prefix from argv0.
11331     set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
11332     set gitk_libdir [file join $gitk_prefix share gitk lib]
11333     set gitk_msgsdir [file join $gitk_libdir msgs]
11334     unset gitk_prefix
11335 }
11336
11337 ## Internationalization (i18n) through msgcat and gettext. See
11338 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
11339 package require msgcat
11340 namespace import ::msgcat::mc
11341 ## And eventually load the actual message catalog
11342 ::msgcat::mcload $gitk_msgsdir
11343
11344 catch {source ~/.gitk}
11345
11346 font create optionfont -family sans-serif -size -12
11347
11348 parsefont mainfont $mainfont
11349 eval font create mainfont [fontflags mainfont]
11350 eval font create mainfontbold [fontflags mainfont 1]
11351
11352 parsefont textfont $textfont
11353 eval font create textfont [fontflags textfont]
11354 eval font create textfontbold [fontflags textfont 1]
11355
11356 parsefont uifont $uifont
11357 eval font create uifont [fontflags uifont]
11358
11359 setoptions
11360
11361 # check that we can find a .git directory somewhere...
11362 if {[catch {set gitdir [gitdir]}]} {
11363     show_error {} . [mc "Cannot find a git repository here."]
11364     exit 1
11365 }
11366 if {![file isdirectory $gitdir]} {
11367     show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
11368     exit 1
11369 }
11370
11371 set selecthead {}
11372 set selectheadid {}
11373
11374 set revtreeargs {}
11375 set cmdline_files {}
11376 set i 0
11377 set revtreeargscmd {}
11378 foreach arg $argv {
11379     switch -glob -- $arg {
11380         "" { }
11381         "--" {
11382             set cmdline_files [lrange $argv [expr {$i + 1}] end]
11383             break
11384         }
11385         "--select-commit=*" {
11386             set selecthead [string range $arg 16 end]
11387         }
11388         "--argscmd=*" {
11389             set revtreeargscmd [string range $arg 10 end]
11390         }
11391         default {
11392             lappend revtreeargs $arg
11393         }
11394     }
11395     incr i
11396 }
11397
11398 if {$selecthead eq "HEAD"} {
11399     set selecthead {}
11400 }
11401
11402 if {$i >= [llength $argv] && $revtreeargs ne {}} {
11403     # no -- on command line, but some arguments (other than --argscmd)
11404     if {[catch {
11405         set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
11406         set cmdline_files [split $f "\n"]
11407         set n [llength $cmdline_files]
11408         set revtreeargs [lrange $revtreeargs 0 end-$n]
11409         # Unfortunately git rev-parse doesn't produce an error when
11410         # something is both a revision and a filename.  To be consistent
11411         # with git log and git rev-list, check revtreeargs for filenames.
11412         foreach arg $revtreeargs {
11413             if {[file exists $arg]} {
11414                 show_error {} . [mc "Ambiguous argument '%s': both revision\
11415                                  and filename" $arg]
11416                 exit 1
11417             }
11418         }
11419     } err]} {
11420         # unfortunately we get both stdout and stderr in $err,
11421         # so look for "fatal:".
11422         set i [string first "fatal:" $err]
11423         if {$i > 0} {
11424             set err [string range $err [expr {$i + 6}] end]
11425         }
11426         show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
11427         exit 1
11428     }
11429 }
11430
11431 set nullid "0000000000000000000000000000000000000000"
11432 set nullid2 "0000000000000000000000000000000000000001"
11433 set nullfile "/dev/null"
11434
11435 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
11436 if {![info exists have_ttk]} {
11437     set have_ttk [llength [info commands ::ttk::style]]
11438 }
11439 set use_ttk [expr {$have_ttk && $want_ttk}]
11440 set NS [expr {$use_ttk ? "ttk" : ""}]
11441
11442 set git_version [join [lrange [split [lindex [exec git version] end] .] 0 2] .]
11443
11444 set runq {}
11445 set history {}
11446 set historyindex 0
11447 set fh_serial 0
11448 set nhl_names {}
11449 set highlight_paths {}
11450 set findpattern {}
11451 set searchdirn -forwards
11452 set boldids {}
11453 set boldnameids {}
11454 set diffelide {0 0}
11455 set markingmatches 0
11456 set linkentercount 0
11457 set need_redisplay 0
11458 set nrows_drawn 0
11459 set firsttabstop 0
11460
11461 set nextviewnum 1
11462 set curview 0
11463 set selectedview 0
11464 set selectedhlview [mc "None"]
11465 set highlight_related [mc "None"]
11466 set highlight_files {}
11467 set viewfiles(0) {}
11468 set viewperm(0) 0
11469 set viewargs(0) {}
11470 set viewargscmd(0) {}
11471
11472 set selectedline {}
11473 set numcommits 0
11474 set loginstance 0
11475 set cmdlineok 0
11476 set stopped 0
11477 set stuffsaved 0
11478 set patchnum 0
11479 set lserial 0
11480 set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
11481 setcoords
11482 makewindow
11483 catch {
11484     image create photo gitlogo      -width 16 -height 16
11485
11486     image create photo gitlogominus -width  4 -height  2
11487     gitlogominus put #C00000 -to 0 0 4 2
11488     gitlogo copy gitlogominus -to  1 5
11489     gitlogo copy gitlogominus -to  6 5
11490     gitlogo copy gitlogominus -to 11 5
11491     image delete gitlogominus
11492
11493     image create photo gitlogoplus  -width  4 -height  4
11494     gitlogoplus  put #008000 -to 1 0 3 4
11495     gitlogoplus  put #008000 -to 0 1 4 3
11496     gitlogo copy gitlogoplus  -to  1 9
11497     gitlogo copy gitlogoplus  -to  6 9
11498     gitlogo copy gitlogoplus  -to 11 9
11499     image delete gitlogoplus
11500
11501     image create photo gitlogo32    -width 32 -height 32
11502     gitlogo32 copy gitlogo -zoom 2 2
11503
11504     wm iconphoto . -default gitlogo gitlogo32
11505 }
11506 # wait for the window to become visible
11507 tkwait visibility .
11508 wm title . "[file tail $argv0]: [file tail [pwd]]"
11509 update
11510 readrefs
11511
11512 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
11513     # create a view for the files/dirs specified on the command line
11514     set curview 1
11515     set selectedview 1
11516     set nextviewnum 2
11517     set viewname(1) [mc "Command line"]
11518     set viewfiles(1) $cmdline_files
11519     set viewargs(1) $revtreeargs
11520     set viewargscmd(1) $revtreeargscmd
11521     set viewperm(1) 0
11522     set vdatemode(1) 0
11523     addviewmenu 1
11524     .bar.view entryconf [mca "Edit view..."] -state normal
11525     .bar.view entryconf [mca "Delete view"] -state normal
11526 }
11527
11528 if {[info exists permviews]} {
11529     foreach v $permviews {
11530         set n $nextviewnum
11531         incr nextviewnum
11532         set viewname($n) [lindex $v 0]
11533         set viewfiles($n) [lindex $v 1]
11534         set viewargs($n) [lindex $v 2]
11535         set viewargscmd($n) [lindex $v 3]
11536         set viewperm($n) 1
11537         addviewmenu $n
11538     }
11539 }
11540
11541 if {[tk windowingsystem] eq "win32"} {
11542     focus -force .
11543 }
11544
11545 getcommits {}