gitk

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