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