gitk

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