gitk

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