gitk

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