gitk

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