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     {reflabel  l    +  {}               {mc "References (space separated list):"}}
3676     {refs      t15  .. {}               {mc "Branches & tags:"}}
3677     {allrefs   b    *. "--all"          {mc "All refs"}}
3678     {branches  b    .  "--branches"     {mc "All (local) branches"}}
3679     {tags      b    .  "--tags"         {mc "All tags"}}
3680     {remotes   b    .  "--remotes"      {mc "All remote-tracking branches"}}
3681     {commitlbl l    +  {}               {mc "Commit Info (regular expressions):"}}
3682     {author    t15  .. "--author=*"     {mc "Author:"}}
3683     {committer t15  .  "--committer=*"  {mc "Committer:"}}
3684     {loginfo   t15  .. "--grep=*"       {mc "Commit Message:"}}
3685     {allmatch  b    .. "--all-match"    {mc "Matches all Commit Info criteria"}}
3686     {changes_l l    +  {}               {mc "Changes to Files:"}}
3687     {pickaxe_s r0   .  {}               {mc "Fixed String"}}
3688     {pickaxe_t r1   .  "--pickaxe-regex"  {mc "Regular Expression"}}
3689     {pickaxe   t15  .. "-S*"            {mc "Search string:"}}
3690     {datelabel l    +  {}               {mc "Commit Dates (\"2 weeks ago\", \"2009-03-17 15:27:38\", \"March 17, 2009 15:27:38\"):"}}
3691     {since     t15  ..  {"--since=*" "--after=*"}  {mc "Since:"}}
3692     {until     t15  .   {"--until=*" "--before=*"} {mc "Until:"}}
3693     {limit_lbl l    +  {}               {mc "Limit and/or skip a number of revisions (positive integer):"}}
3694     {limit     t10  *. "--max-count=*"  {mc "Number to show:"}}
3695     {skip      t10  .  "--skip=*"       {mc "Number to skip:"}}
3696     {misc_lbl  l    +  {}               {mc "Miscellaneous options:"}}
3697     {dorder    b    *. {"--date-order" "-d"}      {mc "Strictly sort by date"}}
3698     {lright    b    .  "--left-right"   {mc "Mark branch sides"}}
3699     {first     b    .  "--first-parent" {mc "Limit to first parent"}}
3700     {args      t50  *. {}               {mc "Additional arguments to git log:"}}
3701     {allpaths  path +  {}               {mc "Enter files and directories to include, one per line:"}}
3702     {cmd       t50= +  {}               {mc "Command to generate more commits to include:"}}
3703     }
3704
3705 proc encode_view_opts {n} {
3706     global known_view_options newviewopts
3707
3708     set rargs [list]
3709     foreach opt $known_view_options {
3710         set patterns [lindex $opt 3]
3711         if {$patterns eq {}} continue
3712         set pattern [lindex $patterns 0]
3713
3714         if {[lindex $opt 1] eq "b"} {
3715             set val $newviewopts($n,[lindex $opt 0])
3716             if {$val} {
3717                 lappend rargs $pattern
3718             }
3719         } elseif {[regexp {^r(\d+)$} [lindex $opt 1] type value]} {
3720             regexp {^(.*_)} [lindex $opt 0] uselessvar button_id
3721             set val $newviewopts($n,$button_id)
3722             if {$val eq $value} {
3723                 lappend rargs $pattern
3724             }
3725         } else {
3726             set val $newviewopts($n,[lindex $opt 0])
3727             set val [string trim $val]
3728             if {$val ne {}} {
3729                 set pfix [string range $pattern 0 end-1]
3730                 lappend rargs $pfix$val
3731             }
3732         }
3733     }
3734     set rargs [concat $rargs [shellsplit $newviewopts($n,refs)]]
3735     return [concat $rargs [shellsplit $newviewopts($n,args)]]
3736 }
3737
3738 proc decode_view_opts {n view_args} {
3739     global known_view_options newviewopts
3740
3741     foreach opt $known_view_options {
3742         set id [lindex $opt 0]
3743         if {[lindex $opt 1] eq "b"} {
3744             # Checkboxes
3745             set val 0
3746         } elseif {[regexp {^r(\d+)$} [lindex $opt 1]]} {
3747             # Radiobuttons
3748             regexp {^(.*_)} $id uselessvar id
3749             set val 0
3750         } else {
3751             # Text fields
3752             set val {}
3753         }
3754         set newviewopts($n,$id) $val
3755     }
3756     set oargs [list]
3757     set refargs [list]
3758     foreach arg $view_args {
3759         if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
3760             && ![info exists found(limit)]} {
3761             set newviewopts($n,limit) $cnt
3762             set found(limit) 1
3763             continue
3764         }
3765         catch { unset val }
3766         foreach opt $known_view_options {
3767             set id [lindex $opt 0]
3768             if {[info exists found($id)]} continue
3769             foreach pattern [lindex $opt 3] {
3770                 if {![string match $pattern $arg]} continue
3771                 if {[lindex $opt 1] eq "b"} {
3772                     # Check buttons
3773                     set val 1
3774                 } elseif {[regexp {^r(\d+)$} [lindex $opt 1] match num]} {
3775                     # Radio buttons
3776                     regexp {^(.*_)} $id uselessvar id
3777                     set val $num
3778                 } else {
3779                     # Text input fields
3780                     set size [string length $pattern]
3781                     set val [string range $arg [expr {$size-1}] end]
3782                 }
3783                 set newviewopts($n,$id) $val
3784                 set found($id) 1
3785                 break
3786             }
3787             if {[info exists val]} break
3788         }
3789         if {[info exists val]} continue
3790         if {[regexp {^-} $arg]} {
3791             lappend oargs $arg
3792         } else {
3793             lappend refargs $arg
3794         }
3795     }
3796     set newviewopts($n,refs) [shellarglist $refargs]
3797     set newviewopts($n,args) [shellarglist $oargs]
3798 }
3799
3800 proc edit_or_newview {} {
3801     global curview
3802
3803     if {$curview > 0} {
3804         editview
3805     } else {
3806         newview 0
3807     }
3808 }
3809
3810 proc editview {} {
3811     global curview
3812     global viewname viewperm newviewname newviewopts
3813     global viewargs viewargscmd
3814
3815     set top .gitkvedit-$curview
3816     if {[winfo exists $top]} {
3817         raise $top
3818         return
3819     }
3820     set newviewname($curview)      $viewname($curview)
3821     set newviewopts($curview,perm) $viewperm($curview)
3822     set newviewopts($curview,cmd)  $viewargscmd($curview)
3823     decode_view_opts $curview $viewargs($curview)
3824     vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
3825 }
3826
3827 proc vieweditor {top n title} {
3828     global newviewname newviewopts viewfiles bgcolor
3829     global known_view_options
3830
3831     toplevel $top
3832     wm title $top [concat $title "-- criteria for selecting revisions"]
3833     make_transient $top .
3834
3835     # View name
3836     frame $top.nfr
3837     label $top.nl -text [mc "View Name:"]
3838     entry $top.name -width 20 -textvariable newviewname($n)
3839     pack $top.nfr -in $top -fill x -pady 5 -padx 3
3840     pack $top.nl -in $top.nfr -side left -padx {0 5}
3841     pack $top.name -in $top.nfr -side left -padx {0 25}
3842
3843     # View options
3844     set cframe $top.nfr
3845     set cexpand 0
3846     set cnt 0
3847     foreach opt $known_view_options {
3848         set id [lindex $opt 0]
3849         set type [lindex $opt 1]
3850         set flags [lindex $opt 2]
3851         set title [eval [lindex $opt 4]]
3852         set lxpad 0
3853
3854         if {$flags eq "+" || $flags eq "*"} {
3855             set cframe $top.fr$cnt
3856             incr cnt
3857             frame $cframe
3858             pack $cframe -in $top -fill x -pady 3 -padx 3
3859             set cexpand [expr {$flags eq "*"}]
3860         } elseif {$flags eq ".." || $flags eq "*."} {
3861             set cframe $top.fr$cnt
3862             incr cnt
3863             frame $cframe
3864             pack $cframe -in $top -fill x -pady 3 -padx [list 15 3]
3865             set cexpand [expr {$flags eq "*."}]
3866         } else {
3867             set lxpad 5
3868         }
3869
3870         if {$type eq "l"} {
3871             label $cframe.l_$id -text $title
3872             pack $cframe.l_$id -in $cframe -side left -pady [list 3 0] -anchor w
3873         } elseif {$type eq "b"} {
3874             checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
3875             pack $cframe.c_$id -in $cframe -side left \
3876                 -padx [list $lxpad 0] -expand $cexpand -anchor w
3877         } elseif {[regexp {^r(\d+)$} $type type sz]} {
3878             regexp {^(.*_)} $id uselessvar button_id
3879             radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz
3880             pack $cframe.c_$id -in $cframe -side left \
3881                 -padx [list $lxpad 0] -expand $cexpand -anchor w
3882         } elseif {[regexp {^t(\d+)$} $type type sz]} {
3883             message $cframe.l_$id -aspect 1500 -text $title
3884             entry $cframe.e_$id -width $sz -background $bgcolor \
3885                 -textvariable newviewopts($n,$id)
3886             pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
3887             pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
3888         } elseif {[regexp {^t(\d+)=$} $type type sz]} {
3889             message $cframe.l_$id -aspect 1500 -text $title
3890             entry $cframe.e_$id -width $sz -background $bgcolor \
3891                 -textvariable newviewopts($n,$id)
3892             pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
3893             pack $cframe.e_$id -in $cframe -side top -fill x
3894         } elseif {$type eq "path"} {
3895             message $top.l -aspect 1500 -text $title
3896             pack $top.l -in $top -side top -pady [list 3 0] -anchor w -padx 3
3897             text $top.t -width 40 -height 5 -background $bgcolor -font uifont
3898             if {[info exists viewfiles($n)]} {
3899                 foreach f $viewfiles($n) {
3900                     $top.t insert end $f
3901                     $top.t insert end "\n"
3902                 }
3903                 $top.t delete {end - 1c} end
3904                 $top.t mark set insert 0.0
3905             }
3906             pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
3907         }
3908     }
3909
3910     frame $top.buts
3911     button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
3912     button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
3913     button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
3914     bind $top <Control-Return> [list newviewok $top $n]
3915     bind $top <F5> [list newviewok $top $n 1]
3916     bind $top <Escape> [list destroy $top]
3917     grid $top.buts.ok $top.buts.apply $top.buts.can
3918     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3919     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3920     grid columnconfigure $top.buts 2 -weight 1 -uniform a
3921     pack $top.buts -in $top -side top -fill x
3922     focus $top.t
3923 }
3924
3925 proc doviewmenu {m first cmd op argv} {
3926     set nmenu [$m index end]
3927     for {set i $first} {$i <= $nmenu} {incr i} {
3928         if {[$m entrycget $i -command] eq $cmd} {
3929             eval $m $op $i $argv
3930             break
3931         }
3932     }
3933 }
3934
3935 proc allviewmenus {n op args} {
3936     # global viewhlmenu
3937
3938     doviewmenu .bar.view 5 [list showview $n] $op $args
3939     # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
3940 }
3941
3942 proc newviewok {top n {apply 0}} {
3943     global nextviewnum newviewperm newviewname newishighlight
3944     global viewname viewfiles viewperm selectedview curview
3945     global viewargs viewargscmd newviewopts viewhlmenu
3946
3947     if {[catch {
3948         set newargs [encode_view_opts $n]
3949     } err]} {
3950         error_popup "[mc "Error in commit selection arguments:"] $err" $top
3951         return
3952     }
3953     set files {}
3954     foreach f [split [$top.t get 0.0 end] "\n"] {
3955         set ft [string trim $f]
3956         if {$ft ne {}} {
3957             lappend files $ft
3958         }
3959     }
3960     if {![info exists viewfiles($n)]} {
3961         # creating a new view
3962         incr nextviewnum
3963         set viewname($n) $newviewname($n)
3964         set viewperm($n) $newviewopts($n,perm)
3965         set viewfiles($n) $files
3966         set viewargs($n) $newargs
3967         set viewargscmd($n) $newviewopts($n,cmd)
3968         addviewmenu $n
3969         if {!$newishighlight} {
3970             run showview $n
3971         } else {
3972             run addvhighlight $n
3973         }
3974     } else {
3975         # editing an existing view
3976         set viewperm($n) $newviewopts($n,perm)
3977         if {$newviewname($n) ne $viewname($n)} {
3978             set viewname($n) $newviewname($n)
3979             doviewmenu .bar.view 5 [list showview $n] \
3980                 entryconf [list -label $viewname($n)]
3981             # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
3982                 # entryconf [list -label $viewname($n) -value $viewname($n)]
3983         }
3984         if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
3985                 $newviewopts($n,cmd) ne $viewargscmd($n)} {
3986             set viewfiles($n) $files
3987             set viewargs($n) $newargs
3988             set viewargscmd($n) $newviewopts($n,cmd)
3989             if {$curview == $n} {
3990                 run reloadcommits
3991             }
3992         }
3993     }
3994     if {$apply} return
3995     catch {destroy $top}
3996 }
3997
3998 proc delview {} {
3999     global curview viewperm hlview selectedhlview
4000
4001     if {$curview == 0} return
4002     if {[info exists hlview] && $hlview == $curview} {
4003         set selectedhlview [mc "None"]
4004         unset hlview
4005     }
4006     allviewmenus $curview delete
4007     set viewperm($curview) 0
4008     showview 0
4009 }
4010
4011 proc addviewmenu {n} {
4012     global viewname viewhlmenu
4013
4014     .bar.view add radiobutton -label $viewname($n) \
4015         -command [list showview $n] -variable selectedview -value $n
4016     #$viewhlmenu add radiobutton -label $viewname($n) \
4017     #   -command [list addvhighlight $n] -variable selectedhlview
4018 }
4019
4020 proc showview {n} {
4021     global curview cached_commitrow ordertok
4022     global displayorder parentlist rowidlist rowisopt rowfinal
4023     global colormap rowtextx nextcolor canvxmax
4024     global numcommits viewcomplete
4025     global selectedline currentid canv canvy0
4026     global treediffs
4027     global pending_select mainheadid
4028     global commitidx
4029     global selectedview
4030     global hlview selectedhlview commitinterest
4031
4032     if {$n == $curview} return
4033     set selid {}
4034     set ymax [lindex [$canv cget -scrollregion] 3]
4035     set span [$canv yview]
4036     set ytop [expr {[lindex $span 0] * $ymax}]
4037     set ybot [expr {[lindex $span 1] * $ymax}]
4038     set yscreen [expr {($ybot - $ytop) / 2}]
4039     if {$selectedline ne {}} {
4040         set selid $currentid
4041         set y [yc $selectedline]
4042         if {$ytop < $y && $y < $ybot} {
4043             set yscreen [expr {$y - $ytop}]
4044         }
4045     } elseif {[info exists pending_select]} {
4046         set selid $pending_select
4047         unset pending_select
4048     }
4049     unselectline
4050     normalline
4051     catch {unset treediffs}
4052     clear_display
4053     if {[info exists hlview] && $hlview == $n} {
4054         unset hlview
4055         set selectedhlview [mc "None"]
4056     }
4057     catch {unset commitinterest}
4058     catch {unset cached_commitrow}
4059     catch {unset ordertok}
4060
4061     set curview $n
4062     set selectedview $n
4063     .bar.view entryconf [mca "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
4064     .bar.view entryconf [mca "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
4065
4066     run refill_reflist
4067     if {![info exists viewcomplete($n)]} {
4068         getcommits $selid
4069         return
4070     }
4071
4072     set displayorder {}
4073     set parentlist {}
4074     set rowidlist {}
4075     set rowisopt {}
4076     set rowfinal {}
4077     set numcommits $commitidx($n)
4078
4079     catch {unset colormap}
4080     catch {unset rowtextx}
4081     set nextcolor 0
4082     set canvxmax [$canv cget -width]
4083     set curview $n
4084     set row 0
4085     setcanvscroll
4086     set yf 0
4087     set row {}
4088     if {$selid ne {} && [commitinview $selid $n]} {
4089         set row [rowofcommit $selid]
4090         # try to get the selected row in the same position on the screen
4091         set ymax [lindex [$canv cget -scrollregion] 3]
4092         set ytop [expr {[yc $row] - $yscreen}]
4093         if {$ytop < 0} {
4094             set ytop 0
4095         }
4096         set yf [expr {$ytop * 1.0 / $ymax}]
4097     }
4098     allcanvs yview moveto $yf
4099     drawvisible
4100     if {$row ne {}} {
4101         selectline $row 0
4102     } elseif {!$viewcomplete($n)} {
4103         reset_pending_select $selid
4104     } else {
4105         reset_pending_select {}
4106
4107         if {[commitinview $pending_select $curview]} {
4108             selectline [rowofcommit $pending_select] 1
4109         } else {
4110             set row [first_real_row]
4111             if {$row < $numcommits} {
4112                 selectline $row 0
4113             }
4114         }
4115     }
4116     if {!$viewcomplete($n)} {
4117         if {$numcommits == 0} {
4118             show_status [mc "Reading commits..."]
4119         }
4120     } elseif {$numcommits == 0} {
4121         show_status [mc "No commits selected"]
4122     }
4123 }
4124
4125 # Stuff relating to the highlighting facility
4126
4127 proc ishighlighted {id} {
4128     global vhighlights fhighlights nhighlights rhighlights
4129
4130     if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
4131         return $nhighlights($id)
4132     }
4133     if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
4134         return $vhighlights($id)
4135     }
4136     if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
4137         return $fhighlights($id)
4138     }
4139     if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4140         return $rhighlights($id)
4141     }
4142     return 0
4143 }
4144
4145 proc bolden {id font} {
4146     global canv linehtag currentid boldids need_redisplay markedid
4147
4148     # need_redisplay = 1 means the display is stale and about to be redrawn
4149     if {$need_redisplay} return
4150     lappend boldids $id
4151     $canv itemconf $linehtag($id) -font $font
4152     if {[info exists currentid] && $id eq $currentid} {
4153         $canv delete secsel
4154         set t [eval $canv create rect [$canv bbox $linehtag($id)] \
4155                    -outline {{}} -tags secsel \
4156                    -fill [$canv cget -selectbackground]]
4157         $canv lower $t
4158     }
4159     if {[info exists markedid] && $id eq $markedid} {
4160         make_idmark $id
4161     }
4162 }
4163
4164 proc bolden_name {id font} {
4165     global canv2 linentag currentid boldnameids need_redisplay
4166
4167     if {$need_redisplay} return
4168     lappend boldnameids $id
4169     $canv2 itemconf $linentag($id) -font $font
4170     if {[info exists currentid] && $id eq $currentid} {
4171         $canv2 delete secsel
4172         set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
4173                    -outline {{}} -tags secsel \
4174                    -fill [$canv2 cget -selectbackground]]
4175         $canv2 lower $t
4176     }
4177 }
4178
4179 proc unbolden {} {
4180     global boldids
4181
4182     set stillbold {}
4183     foreach id $boldids {
4184         if {![ishighlighted $id]} {
4185             bolden $id mainfont
4186         } else {
4187             lappend stillbold $id
4188         }
4189     }
4190     set boldids $stillbold
4191 }
4192
4193 proc addvhighlight {n} {
4194     global hlview viewcomplete curview vhl_done commitidx
4195
4196     if {[info exists hlview]} {
4197         delvhighlight
4198     }
4199     set hlview $n
4200     if {$n != $curview && ![info exists viewcomplete($n)]} {
4201         start_rev_list $n
4202     }
4203     set vhl_done $commitidx($hlview)
4204     if {$vhl_done > 0} {
4205         drawvisible
4206     }
4207 }
4208
4209 proc delvhighlight {} {
4210     global hlview vhighlights
4211
4212     if {![info exists hlview]} return
4213     unset hlview
4214     catch {unset vhighlights}
4215     unbolden
4216 }
4217
4218 proc vhighlightmore {} {
4219     global hlview vhl_done commitidx vhighlights curview
4220
4221     set max $commitidx($hlview)
4222     set vr [visiblerows]
4223     set r0 [lindex $vr 0]
4224     set r1 [lindex $vr 1]
4225     for {set i $vhl_done} {$i < $max} {incr i} {
4226         set id [commitonrow $i $hlview]
4227         if {[commitinview $id $curview]} {
4228             set row [rowofcommit $id]
4229             if {$r0 <= $row && $row <= $r1} {
4230                 if {![highlighted $row]} {
4231                     bolden $id mainfontbold
4232                 }
4233                 set vhighlights($id) 1
4234             }
4235         }
4236     }
4237     set vhl_done $max
4238     return 0
4239 }
4240
4241 proc askvhighlight {row id} {
4242     global hlview vhighlights iddrawn
4243
4244     if {[commitinview $id $hlview]} {
4245         if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
4246             bolden $id mainfontbold
4247         }
4248         set vhighlights($id) 1
4249     } else {
4250         set vhighlights($id) 0
4251     }
4252 }
4253
4254 proc hfiles_change {} {
4255     global highlight_files filehighlight fhighlights fh_serial
4256     global highlight_paths
4257
4258     if {[info exists filehighlight]} {
4259         # delete previous highlights
4260         catch {close $filehighlight}
4261         unset filehighlight
4262         catch {unset fhighlights}
4263         unbolden
4264         unhighlight_filelist
4265     }
4266     set highlight_paths {}
4267     after cancel do_file_hl $fh_serial
4268     incr fh_serial
4269     if {$highlight_files ne {}} {
4270         after 300 do_file_hl $fh_serial
4271     }
4272 }
4273
4274 proc gdttype_change {name ix op} {
4275     global gdttype highlight_files findstring findpattern
4276
4277     stopfinding
4278     if {$findstring ne {}} {
4279         if {$gdttype eq [mc "containing:"]} {
4280             if {$highlight_files ne {}} {
4281                 set highlight_files {}
4282                 hfiles_change
4283             }
4284             findcom_change
4285         } else {
4286             if {$findpattern ne {}} {
4287                 set findpattern {}
4288                 findcom_change
4289             }
4290             set highlight_files $findstring
4291             hfiles_change
4292         }
4293         drawvisible
4294     }
4295     # enable/disable findtype/findloc menus too
4296 }
4297
4298 proc find_change {name ix op} {
4299     global gdttype findstring highlight_files
4300
4301     stopfinding
4302     if {$gdttype eq [mc "containing:"]} {
4303         findcom_change
4304     } else {
4305         if {$highlight_files ne $findstring} {
4306             set highlight_files $findstring
4307             hfiles_change
4308         }
4309     }
4310     drawvisible
4311 }
4312
4313 proc findcom_change args {
4314     global nhighlights boldnameids
4315     global findpattern findtype findstring gdttype
4316
4317     stopfinding
4318     # delete previous highlights, if any
4319     foreach id $boldnameids {
4320         bolden_name $id mainfont
4321     }
4322     set boldnameids {}
4323     catch {unset nhighlights}
4324     unbolden
4325     unmarkmatches
4326     if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
4327         set findpattern {}
4328     } elseif {$findtype eq [mc "Regexp"]} {
4329         set findpattern $findstring
4330     } else {
4331         set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4332                    $findstring]
4333         set findpattern "*$e*"
4334     }
4335 }
4336
4337 proc makepatterns {l} {
4338     set ret {}
4339     foreach e $l {
4340         set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4341         if {[string index $ee end] eq "/"} {
4342             lappend ret "$ee*"
4343         } else {
4344             lappend ret $ee
4345             lappend ret "$ee/*"
4346         }
4347     }
4348     return $ret
4349 }
4350
4351 proc do_file_hl {serial} {
4352     global highlight_files filehighlight highlight_paths gdttype fhl_list
4353
4354     if {$gdttype eq [mc "touching paths:"]} {
4355         if {[catch {set paths [shellsplit $highlight_files]}]} return
4356         set highlight_paths [makepatterns $paths]
4357         highlight_filelist
4358         set gdtargs [concat -- $paths]
4359     } elseif {$gdttype eq [mc "adding/removing string:"]} {
4360         set gdtargs [list "-S$highlight_files"]
4361     } else {
4362         # must be "containing:", i.e. we're searching commit info
4363         return
4364     }
4365     set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
4366     set filehighlight [open $cmd r+]
4367     fconfigure $filehighlight -blocking 0
4368     filerun $filehighlight readfhighlight
4369     set fhl_list {}
4370     drawvisible
4371     flushhighlights
4372 }
4373
4374 proc flushhighlights {} {
4375     global filehighlight fhl_list
4376
4377     if {[info exists filehighlight]} {
4378         lappend fhl_list {}
4379         puts $filehighlight ""
4380         flush $filehighlight
4381     }
4382 }
4383
4384 proc askfilehighlight {row id} {
4385     global filehighlight fhighlights fhl_list
4386
4387     lappend fhl_list $id
4388     set fhighlights($id) -1
4389     puts $filehighlight $id
4390 }
4391
4392 proc readfhighlight {} {
4393     global filehighlight fhighlights curview iddrawn
4394     global fhl_list find_dirn
4395
4396     if {![info exists filehighlight]} {
4397         return 0
4398     }
4399     set nr 0
4400     while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4401         set line [string trim $line]
4402         set i [lsearch -exact $fhl_list $line]
4403         if {$i < 0} continue
4404         for {set j 0} {$j < $i} {incr j} {
4405             set id [lindex $fhl_list $j]
4406             set fhighlights($id) 0
4407         }
4408         set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4409         if {$line eq {}} continue
4410         if {![commitinview $line $curview]} continue
4411         if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4412             bolden $line mainfontbold
4413         }
4414         set fhighlights($line) 1
4415     }
4416     if {[eof $filehighlight]} {
4417         # strange...
4418         puts "oops, git diff-tree died"
4419         catch {close $filehighlight}
4420         unset filehighlight
4421         return 0
4422     }
4423     if {[info exists find_dirn]} {
4424         run findmore
4425     }
4426     return 1
4427 }
4428
4429 proc doesmatch {f} {
4430     global findtype findpattern
4431
4432     if {$findtype eq [mc "Regexp"]} {
4433         return [regexp $findpattern $f]
4434     } elseif {$findtype eq [mc "IgnCase"]} {
4435         return [string match -nocase $findpattern $f]
4436     } else {
4437         return [string match $findpattern $f]
4438     }
4439 }
4440
4441 proc askfindhighlight {row id} {
4442     global nhighlights commitinfo iddrawn
4443     global findloc
4444     global markingmatches
4445
4446     if {![info exists commitinfo($id)]} {
4447         getcommit $id
4448     }
4449     set info $commitinfo($id)
4450     set isbold 0
4451     set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
4452     foreach f $info ty $fldtypes {
4453         if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4454             [doesmatch $f]} {
4455             if {$ty eq [mc "Author"]} {
4456                 set isbold 2
4457                 break
4458             }
4459             set isbold 1
4460         }
4461     }
4462     if {$isbold && [info exists iddrawn($id)]} {
4463         if {![ishighlighted $id]} {
4464             bolden $id mainfontbold
4465             if {$isbold > 1} {
4466                 bolden_name $id mainfontbold
4467             }
4468         }
4469         if {$markingmatches} {
4470             markrowmatches $row $id
4471         }
4472     }
4473     set nhighlights($id) $isbold
4474 }
4475
4476 proc markrowmatches {row id} {
4477     global canv canv2 linehtag linentag commitinfo findloc
4478
4479     set headline [lindex $commitinfo($id) 0]
4480     set author [lindex $commitinfo($id) 1]
4481     $canv delete match$row
4482     $canv2 delete match$row
4483     if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4484         set m [findmatches $headline]
4485         if {$m ne {}} {
4486             markmatches $canv $row $headline $linehtag($id) $m \
4487                 [$canv itemcget $linehtag($id) -font] $row
4488         }
4489     }
4490     if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4491         set m [findmatches $author]
4492         if {$m ne {}} {
4493             markmatches $canv2 $row $author $linentag($id) $m \
4494                 [$canv2 itemcget $linentag($id) -font] $row
4495         }
4496     }
4497 }
4498
4499 proc vrel_change {name ix op} {
4500     global highlight_related
4501
4502     rhighlight_none
4503     if {$highlight_related ne [mc "None"]} {
4504         run drawvisible
4505     }
4506 }
4507
4508 # prepare for testing whether commits are descendents or ancestors of a
4509 proc rhighlight_sel {a} {
4510     global descendent desc_todo ancestor anc_todo
4511     global highlight_related
4512
4513     catch {unset descendent}
4514     set desc_todo [list $a]
4515     catch {unset ancestor}
4516     set anc_todo [list $a]
4517     if {$highlight_related ne [mc "None"]} {
4518         rhighlight_none
4519         run drawvisible
4520     }
4521 }
4522
4523 proc rhighlight_none {} {
4524     global rhighlights
4525
4526     catch {unset rhighlights}
4527     unbolden
4528 }
4529
4530 proc is_descendent {a} {
4531     global curview children descendent desc_todo
4532
4533     set v $curview
4534     set la [rowofcommit $a]
4535     set todo $desc_todo
4536     set leftover {}
4537     set done 0
4538     for {set i 0} {$i < [llength $todo]} {incr i} {
4539         set do [lindex $todo $i]
4540         if {[rowofcommit $do] < $la} {
4541             lappend leftover $do
4542             continue
4543         }
4544         foreach nk $children($v,$do) {
4545             if {![info exists descendent($nk)]} {
4546                 set descendent($nk) 1
4547                 lappend todo $nk
4548                 if {$nk eq $a} {
4549                     set done 1
4550                 }
4551             }
4552         }
4553         if {$done} {
4554             set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4555             return
4556         }
4557     }
4558     set descendent($a) 0
4559     set desc_todo $leftover
4560 }
4561
4562 proc is_ancestor {a} {
4563     global curview parents ancestor anc_todo
4564
4565     set v $curview
4566     set la [rowofcommit $a]
4567     set todo $anc_todo
4568     set leftover {}
4569     set done 0
4570     for {set i 0} {$i < [llength $todo]} {incr i} {
4571         set do [lindex $todo $i]
4572         if {![commitinview $do $v] || [rowofcommit $do] > $la} {
4573             lappend leftover $do
4574             continue
4575         }
4576         foreach np $parents($v,$do) {
4577             if {![info exists ancestor($np)]} {
4578                 set ancestor($np) 1
4579                 lappend todo $np
4580                 if {$np eq $a} {
4581                     set done 1
4582                 }
4583             }
4584         }
4585         if {$done} {
4586             set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4587             return
4588         }
4589     }
4590     set ancestor($a) 0
4591     set anc_todo $leftover
4592 }
4593
4594 proc askrelhighlight {row id} {
4595     global descendent highlight_related iddrawn rhighlights
4596     global selectedline ancestor
4597
4598     if {$selectedline eq {}} return
4599     set isbold 0
4600     if {$highlight_related eq [mc "Descendant"] ||
4601         $highlight_related eq [mc "Not descendant"]} {
4602         if {![info exists descendent($id)]} {
4603             is_descendent $id
4604         }
4605         if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
4606             set isbold 1
4607         }
4608     } elseif {$highlight_related eq [mc "Ancestor"] ||
4609               $highlight_related eq [mc "Not ancestor"]} {
4610         if {![info exists ancestor($id)]} {
4611             is_ancestor $id
4612         }
4613         if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
4614             set isbold 1
4615         }
4616     }
4617     if {[info exists iddrawn($id)]} {
4618         if {$isbold && ![ishighlighted $id]} {
4619             bolden $id mainfontbold
4620         }
4621     }
4622     set rhighlights($id) $isbold
4623 }
4624
4625 # Graph layout functions
4626
4627 proc shortids {ids} {
4628     set res {}
4629     foreach id $ids {
4630         if {[llength $id] > 1} {
4631             lappend res [shortids $id]
4632         } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
4633             lappend res [string range $id 0 7]
4634         } else {
4635             lappend res $id
4636         }
4637     }
4638     return $res
4639 }
4640
4641 proc ntimes {n o} {
4642     set ret {}
4643     set o [list $o]
4644     for {set mask 1} {$mask <= $n} {incr mask $mask} {
4645         if {($n & $mask) != 0} {
4646             set ret [concat $ret $o]
4647         }
4648         set o [concat $o $o]
4649     }
4650     return $ret
4651 }
4652
4653 proc ordertoken {id} {
4654     global ordertok curview varcid varcstart varctok curview parents children
4655     global nullid nullid2
4656
4657     if {[info exists ordertok($id)]} {
4658         return $ordertok($id)
4659     }
4660     set origid $id
4661     set todo {}
4662     while {1} {
4663         if {[info exists varcid($curview,$id)]} {
4664             set a $varcid($curview,$id)
4665             set p [lindex $varcstart($curview) $a]
4666         } else {
4667             set p [lindex $children($curview,$id) 0]
4668         }
4669         if {[info exists ordertok($p)]} {
4670             set tok $ordertok($p)
4671             break
4672         }
4673         set id [first_real_child $curview,$p]
4674         if {$id eq {}} {
4675             # it's a root
4676             set tok [lindex $varctok($curview) $varcid($curview,$p)]
4677             break
4678         }
4679         if {[llength $parents($curview,$id)] == 1} {
4680             lappend todo [list $p {}]
4681         } else {
4682             set j [lsearch -exact $parents($curview,$id) $p]
4683             if {$j < 0} {
4684                 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
4685             }
4686             lappend todo [list $p [strrep $j]]
4687         }
4688     }
4689     for {set i [llength $todo]} {[incr i -1] >= 0} {} {
4690         set p [lindex $todo $i 0]
4691         append tok [lindex $todo $i 1]
4692         set ordertok($p) $tok
4693     }
4694     set ordertok($origid) $tok
4695     return $tok
4696 }
4697
4698 # Work out where id should go in idlist so that order-token
4699 # values increase from left to right
4700 proc idcol {idlist id {i 0}} {
4701     set t [ordertoken $id]
4702     if {$i < 0} {
4703         set i 0
4704     }
4705     if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
4706         if {$i > [llength $idlist]} {
4707             set i [llength $idlist]
4708         }
4709         while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
4710         incr i
4711     } else {
4712         if {$t > [ordertoken [lindex $idlist $i]]} {
4713             while {[incr i] < [llength $idlist] &&
4714                    $t >= [ordertoken [lindex $idlist $i]]} {}
4715         }
4716     }
4717     return $i
4718 }
4719
4720 proc initlayout {} {
4721     global rowidlist rowisopt rowfinal displayorder parentlist
4722     global numcommits canvxmax canv
4723     global nextcolor
4724     global colormap rowtextx
4725
4726     set numcommits 0
4727     set displayorder {}
4728     set parentlist {}
4729     set nextcolor 0
4730     set rowidlist {}
4731     set rowisopt {}
4732     set rowfinal {}
4733     set canvxmax [$canv cget -width]
4734     catch {unset colormap}
4735     catch {unset rowtextx}
4736     setcanvscroll
4737 }
4738
4739 proc setcanvscroll {} {
4740     global canv canv2 canv3 numcommits linespc canvxmax canvy0
4741     global lastscrollset lastscrollrows
4742
4743     set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
4744     $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
4745     $canv2 conf -scrollregion [list 0 0 0 $ymax]
4746     $canv3 conf -scrollregion [list 0 0 0 $ymax]
4747     set lastscrollset [clock clicks -milliseconds]
4748     set lastscrollrows $numcommits
4749 }
4750
4751 proc visiblerows {} {
4752     global canv numcommits linespc
4753
4754     set ymax [lindex [$canv cget -scrollregion] 3]
4755     if {$ymax eq {} || $ymax == 0} return
4756     set f [$canv yview]
4757     set y0 [expr {int([lindex $f 0] * $ymax)}]
4758     set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
4759     if {$r0 < 0} {
4760         set r0 0
4761     }
4762     set y1 [expr {int([lindex $f 1] * $ymax)}]
4763     set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
4764     if {$r1 >= $numcommits} {
4765         set r1 [expr {$numcommits - 1}]
4766     }
4767     return [list $r0 $r1]
4768 }
4769
4770 proc layoutmore {} {
4771     global commitidx viewcomplete curview
4772     global numcommits pending_select curview
4773     global lastscrollset lastscrollrows
4774
4775     if {$lastscrollrows < 100 || $viewcomplete($curview) ||
4776         [clock clicks -milliseconds] - $lastscrollset > 500} {
4777         setcanvscroll
4778     }
4779     if {[info exists pending_select] &&
4780         [commitinview $pending_select $curview]} {
4781         update
4782         selectline [rowofcommit $pending_select] 1
4783     }
4784     drawvisible
4785 }
4786
4787 # With path limiting, we mightn't get the actual HEAD commit,
4788 # so ask git rev-list what is the first ancestor of HEAD that
4789 # touches a file in the path limit.
4790 proc get_viewmainhead {view} {
4791     global viewmainheadid vfilelimit viewinstances mainheadid
4792
4793     catch {
4794         set rfd [open [concat | git rev-list -1 $mainheadid \
4795                            -- $vfilelimit($view)] r]
4796         set j [reg_instance $rfd]
4797         lappend viewinstances($view) $j
4798         fconfigure $rfd -blocking 0
4799         filerun $rfd [list getviewhead $rfd $j $view]
4800         set viewmainheadid($curview) {}
4801     }
4802 }
4803
4804 # git rev-list should give us just 1 line to use as viewmainheadid($view)
4805 proc getviewhead {fd inst view} {
4806     global viewmainheadid commfd curview viewinstances showlocalchanges
4807
4808     set id {}
4809     if {[gets $fd line] < 0} {
4810         if {![eof $fd]} {
4811             return 1
4812         }
4813     } elseif {[string length $line] == 40 && [string is xdigit $line]} {
4814         set id $line
4815     }
4816     set viewmainheadid($view) $id
4817     close $fd
4818     unset commfd($inst)
4819     set i [lsearch -exact $viewinstances($view) $inst]
4820     if {$i >= 0} {
4821         set viewinstances($view) [lreplace $viewinstances($view) $i $i]
4822     }
4823     if {$showlocalchanges && $id ne {} && $view == $curview} {
4824         doshowlocalchanges
4825     }
4826     return 0
4827 }
4828
4829 proc doshowlocalchanges {} {
4830     global curview viewmainheadid
4831
4832     if {$viewmainheadid($curview) eq {}} return
4833     if {[commitinview $viewmainheadid($curview) $curview]} {
4834         dodiffindex
4835     } else {
4836         interestedin $viewmainheadid($curview) dodiffindex
4837     }
4838 }
4839
4840 proc dohidelocalchanges {} {
4841     global nullid nullid2 lserial curview
4842
4843     if {[commitinview $nullid $curview]} {
4844         removefakerow $nullid
4845     }
4846     if {[commitinview $nullid2 $curview]} {
4847         removefakerow $nullid2
4848     }
4849     incr lserial
4850 }
4851
4852 # spawn off a process to do git diff-index --cached HEAD
4853 proc dodiffindex {} {
4854     global lserial showlocalchanges vfilelimit curview
4855     global isworktree
4856
4857     if {!$showlocalchanges || !$isworktree} return
4858     incr lserial
4859     set cmd "|git diff-index --cached HEAD"
4860     if {$vfilelimit($curview) ne {}} {
4861         set cmd [concat $cmd -- $vfilelimit($curview)]
4862     }
4863     set fd [open $cmd r]
4864     fconfigure $fd -blocking 0
4865     set i [reg_instance $fd]
4866     filerun $fd [list readdiffindex $fd $lserial $i]
4867 }
4868
4869 proc readdiffindex {fd serial inst} {
4870     global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
4871     global vfilelimit
4872
4873     set isdiff 1
4874     if {[gets $fd line] < 0} {
4875         if {![eof $fd]} {
4876             return 1
4877         }
4878         set isdiff 0
4879     }
4880     # we only need to see one line and we don't really care what it says...
4881     stop_instance $inst
4882
4883     if {$serial != $lserial} {
4884         return 0
4885     }
4886
4887     # now see if there are any local changes not checked in to the index
4888     set cmd "|git diff-files"
4889     if {$vfilelimit($curview) ne {}} {
4890         set cmd [concat $cmd -- $vfilelimit($curview)]
4891     }
4892     set fd [open $cmd r]
4893     fconfigure $fd -blocking 0
4894     set i [reg_instance $fd]
4895     filerun $fd [list readdifffiles $fd $serial $i]
4896
4897     if {$isdiff && ![commitinview $nullid2 $curview]} {
4898         # add the line for the changes in the index to the graph
4899         set hl [mc "Local changes checked in to index but not committed"]
4900         set commitinfo($nullid2) [list  $hl {} {} {} {} "    $hl\n"]
4901         set commitdata($nullid2) "\n    $hl\n"
4902         if {[commitinview $nullid $curview]} {
4903             removefakerow $nullid
4904         }
4905         insertfakerow $nullid2 $viewmainheadid($curview)
4906     } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
4907         if {[commitinview $nullid $curview]} {
4908             removefakerow $nullid
4909         }
4910         removefakerow $nullid2
4911     }
4912     return 0
4913 }
4914
4915 proc readdifffiles {fd serial inst} {
4916     global viewmainheadid nullid nullid2 curview
4917     global commitinfo commitdata lserial
4918
4919     set isdiff 1
4920     if {[gets $fd line] < 0} {
4921         if {![eof $fd]} {
4922             return 1
4923         }
4924         set isdiff 0
4925     }
4926     # we only need to see one line and we don't really care what it says...
4927     stop_instance $inst
4928
4929     if {$serial != $lserial} {
4930         return 0
4931     }
4932
4933     if {$isdiff && ![commitinview $nullid $curview]} {
4934         # add the line for the local diff to the graph
4935         set hl [mc "Local uncommitted changes, not checked in to index"]
4936         set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
4937         set commitdata($nullid) "\n    $hl\n"
4938         if {[commitinview $nullid2 $curview]} {
4939             set p $nullid2
4940         } else {
4941             set p $viewmainheadid($curview)
4942         }
4943         insertfakerow $nullid $p
4944     } elseif {!$isdiff && [commitinview $nullid $curview]} {
4945         removefakerow $nullid
4946     }
4947     return 0
4948 }
4949
4950 proc nextuse {id row} {
4951     global curview children
4952
4953     if {[info exists children($curview,$id)]} {
4954         foreach kid $children($curview,$id) {
4955             if {![commitinview $kid $curview]} {
4956                 return -1
4957             }
4958             if {[rowofcommit $kid] > $row} {
4959                 return [rowofcommit $kid]
4960             }
4961         }
4962     }
4963     if {[commitinview $id $curview]} {
4964         return [rowofcommit $id]
4965     }
4966     return -1
4967 }
4968
4969 proc prevuse {id row} {
4970     global curview children
4971
4972     set ret -1
4973     if {[info exists children($curview,$id)]} {
4974         foreach kid $children($curview,$id) {
4975             if {![commitinview $kid $curview]} break
4976             if {[rowofcommit $kid] < $row} {
4977                 set ret [rowofcommit $kid]
4978             }
4979         }
4980     }
4981     return $ret
4982 }
4983
4984 proc make_idlist {row} {
4985     global displayorder parentlist uparrowlen downarrowlen mingaplen
4986     global commitidx curview children
4987
4988     set r [expr {$row - $mingaplen - $downarrowlen - 1}]
4989     if {$r < 0} {
4990         set r 0
4991     }
4992     set ra [expr {$row - $downarrowlen}]
4993     if {$ra < 0} {
4994         set ra 0
4995     }
4996     set rb [expr {$row + $uparrowlen}]
4997     if {$rb > $commitidx($curview)} {
4998         set rb $commitidx($curview)
4999     }
5000     make_disporder $r [expr {$rb + 1}]
5001     set ids {}
5002     for {} {$r < $ra} {incr r} {
5003         set nextid [lindex $displayorder [expr {$r + 1}]]
5004         foreach p [lindex $parentlist $r] {
5005             if {$p eq $nextid} continue
5006             set rn [nextuse $p $r]
5007             if {$rn >= $row &&
5008                 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
5009                 lappend ids [list [ordertoken $p] $p]
5010             }
5011         }
5012     }
5013     for {} {$r < $row} {incr r} {
5014         set nextid [lindex $displayorder [expr {$r + 1}]]
5015         foreach p [lindex $parentlist $r] {
5016             if {$p eq $nextid} continue
5017             set rn [nextuse $p $r]
5018             if {$rn < 0 || $rn >= $row} {
5019                 lappend ids [list [ordertoken $p] $p]
5020             }
5021         }
5022     }
5023     set id [lindex $displayorder $row]
5024     lappend ids [list [ordertoken $id] $id]
5025     while {$r < $rb} {
5026         foreach p [lindex $parentlist $r] {
5027             set firstkid [lindex $children($curview,$p) 0]
5028             if {[rowofcommit $firstkid] < $row} {
5029                 lappend ids [list [ordertoken $p] $p]
5030             }
5031         }
5032         incr r
5033         set id [lindex $displayorder $r]
5034         if {$id ne {}} {
5035             set firstkid [lindex $children($curview,$id) 0]
5036             if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
5037                 lappend ids [list [ordertoken $id] $id]
5038             }
5039         }
5040     }
5041     set idlist {}
5042     foreach idx [lsort -unique $ids] {
5043         lappend idlist [lindex $idx 1]
5044     }
5045     return $idlist
5046 }
5047
5048 proc rowsequal {a b} {
5049     while {[set i [lsearch -exact $a {}]] >= 0} {
5050         set a [lreplace $a $i $i]
5051     }
5052     while {[set i [lsearch -exact $b {}]] >= 0} {
5053         set b [lreplace $b $i $i]
5054     }
5055     return [expr {$a eq $b}]
5056 }
5057
5058 proc makeupline {id row rend col} {
5059     global rowidlist uparrowlen downarrowlen mingaplen
5060
5061     for {set r $rend} {1} {set r $rstart} {
5062         set rstart [prevuse $id $r]
5063         if {$rstart < 0} return
5064         if {$rstart < $row} break
5065     }
5066     if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5067         set rstart [expr {$rend - $uparrowlen - 1}]
5068     }
5069     for {set r $rstart} {[incr r] <= $row} {} {
5070         set idlist [lindex $rowidlist $r]
5071         if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5072             set col [idcol $idlist $id $col]
5073             lset rowidlist $r [linsert $idlist $col $id]
5074             changedrow $r
5075         }
5076     }
5077 }
5078
5079 proc layoutrows {row endrow} {
5080     global rowidlist rowisopt rowfinal displayorder
5081     global uparrowlen downarrowlen maxwidth mingaplen
5082     global children parentlist
5083     global commitidx viewcomplete curview
5084
5085     make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
5086     set idlist {}
5087     if {$row > 0} {
5088         set rm1 [expr {$row - 1}]
5089         foreach id [lindex $rowidlist $rm1] {
5090             if {$id ne {}} {
5091                 lappend idlist $id
5092             }
5093         }
5094         set final [lindex $rowfinal $rm1]
5095     }
5096     for {} {$row < $endrow} {incr row} {
5097         set rm1 [expr {$row - 1}]
5098         if {$rm1 < 0 || $idlist eq {}} {
5099             set idlist [make_idlist $row]
5100             set final 1
5101         } else {
5102             set id [lindex $displayorder $rm1]
5103             set col [lsearch -exact $idlist $id]
5104             set idlist [lreplace $idlist $col $col]
5105             foreach p [lindex $parentlist $rm1] {
5106                 if {[lsearch -exact $idlist $p] < 0} {
5107                     set col [idcol $idlist $p $col]
5108                     set idlist [linsert $idlist $col $p]
5109                     # if not the first child, we have to insert a line going up
5110                     if {$id ne [lindex $children($curview,$p) 0]} {
5111                         makeupline $p $rm1 $row $col
5112                     }
5113                 }
5114             }
5115             set id [lindex $displayorder $row]
5116             if {$row > $downarrowlen} {
5117                 set termrow [expr {$row - $downarrowlen - 1}]
5118                 foreach p [lindex $parentlist $termrow] {
5119                     set i [lsearch -exact $idlist $p]
5120                     if {$i < 0} continue
5121                     set nr [nextuse $p $termrow]
5122                     if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5123                         set idlist [lreplace $idlist $i $i]
5124                     }
5125                 }
5126             }
5127             set col [lsearch -exact $idlist $id]
5128             if {$col < 0} {
5129                 set col [idcol $idlist $id]
5130                 set idlist [linsert $idlist $col $id]
5131                 if {$children($curview,$id) ne {}} {
5132                     makeupline $id $rm1 $row $col
5133                 }
5134             }
5135             set r [expr {$row + $uparrowlen - 1}]
5136             if {$r < $commitidx($curview)} {
5137                 set x $col
5138                 foreach p [lindex $parentlist $r] {
5139                     if {[lsearch -exact $idlist $p] >= 0} continue
5140                     set fk [lindex $children($curview,$p) 0]
5141                     if {[rowofcommit $fk] < $row} {
5142                         set x [idcol $idlist $p $x]
5143                         set idlist [linsert $idlist $x $p]
5144                     }
5145                 }
5146                 if {[incr r] < $commitidx($curview)} {
5147                     set p [lindex $displayorder $r]
5148                     if {[lsearch -exact $idlist $p] < 0} {
5149                         set fk [lindex $children($curview,$p) 0]
5150                         if {$fk ne {} && [rowofcommit $fk] < $row} {
5151                             set x [idcol $idlist $p $x]
5152                             set idlist [linsert $idlist $x $p]
5153                         }
5154                     }
5155                 }
5156             }
5157         }
5158         if {$final && !$viewcomplete($curview) &&
5159             $row + $uparrowlen + $mingaplen + $downarrowlen
5160                 >= $commitidx($curview)} {
5161             set final 0
5162         }
5163         set l [llength $rowidlist]
5164         if {$row == $l} {
5165             lappend rowidlist $idlist
5166             lappend rowisopt 0
5167             lappend rowfinal $final
5168         } elseif {$row < $l} {
5169             if {![rowsequal $idlist [lindex $rowidlist $row]]} {
5170                 lset rowidlist $row $idlist
5171                 changedrow $row
5172             }
5173             lset rowfinal $row $final
5174         } else {
5175             set pad [ntimes [expr {$row - $l}] {}]
5176             set rowidlist [concat $rowidlist $pad]
5177             lappend rowidlist $idlist
5178             set rowfinal [concat $rowfinal $pad]
5179             lappend rowfinal $final
5180             set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5181         }
5182     }
5183     return $row
5184 }
5185
5186 proc changedrow {row} {
5187     global displayorder iddrawn rowisopt need_redisplay
5188
5189     set l [llength $rowisopt]
5190     if {$row < $l} {
5191         lset rowisopt $row 0
5192         if {$row + 1 < $l} {
5193             lset rowisopt [expr {$row + 1}] 0
5194             if {$row + 2 < $l} {
5195                 lset rowisopt [expr {$row + 2}] 0
5196             }
5197         }
5198     }
5199     set id [lindex $displayorder $row]
5200     if {[info exists iddrawn($id)]} {
5201         set need_redisplay 1
5202     }
5203 }
5204
5205 proc insert_pad {row col npad} {
5206     global rowidlist
5207
5208     set pad [ntimes $npad {}]
5209     set idlist [lindex $rowidlist $row]
5210     set bef [lrange $idlist 0 [expr {$col - 1}]]
5211     set aft [lrange $idlist $col end]
5212     set i [lsearch -exact $aft {}]
5213     if {$i > 0} {
5214         set aft [lreplace $aft $i $i]
5215     }
5216     lset rowidlist $row [concat $bef $pad $aft]
5217     changedrow $row
5218 }
5219
5220 proc optimize_rows {row col endrow} {
5221     global rowidlist rowisopt displayorder curview children
5222
5223     if {$row < 1} {
5224         set row 1
5225     }
5226     for {} {$row < $endrow} {incr row; set col 0} {
5227         if {[lindex $rowisopt $row]} continue
5228         set haspad 0
5229         set y0 [expr {$row - 1}]
5230         set ym [expr {$row - 2}]
5231         set idlist [lindex $rowidlist $row]
5232         set previdlist [lindex $rowidlist $y0]
5233         if {$idlist eq {} || $previdlist eq {}} continue
5234         if {$ym >= 0} {
5235             set pprevidlist [lindex $rowidlist $ym]
5236             if {$pprevidlist eq {}} continue
5237         } else {
5238             set pprevidlist {}
5239         }
5240         set x0 -1
5241         set xm -1
5242         for {} {$col < [llength $idlist]} {incr col} {
5243             set id [lindex $idlist $col]
5244             if {[lindex $previdlist $col] eq $id} continue
5245             if {$id eq {}} {
5246                 set haspad 1
5247                 continue
5248             }
5249             set x0 [lsearch -exact $previdlist $id]
5250             if {$x0 < 0} continue
5251             set z [expr {$x0 - $col}]
5252             set isarrow 0
5253             set z0 {}
5254             if {$ym >= 0} {
5255                 set xm [lsearch -exact $pprevidlist $id]
5256                 if {$xm >= 0} {
5257                     set z0 [expr {$xm - $x0}]
5258                 }
5259             }
5260             if {$z0 eq {}} {
5261                 # if row y0 is the first child of $id then it's not an arrow
5262                 if {[lindex $children($curview,$id) 0] ne
5263                     [lindex $displayorder $y0]} {
5264                     set isarrow 1
5265                 }
5266             }
5267             if {!$isarrow && $id ne [lindex $displayorder $row] &&
5268                 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5269                 set isarrow 1
5270             }
5271             # Looking at lines from this row to the previous row,
5272             # make them go straight up if they end in an arrow on
5273             # the previous row; otherwise make them go straight up
5274             # or at 45 degrees.
5275             if {$z < -1 || ($z < 0 && $isarrow)} {
5276                 # Line currently goes left too much;
5277                 # insert pads in the previous row, then optimize it
5278                 set npad [expr {-1 - $z + $isarrow}]
5279                 insert_pad $y0 $x0 $npad
5280                 if {$y0 > 0} {
5281                     optimize_rows $y0 $x0 $row
5282                 }
5283                 set previdlist [lindex $rowidlist $y0]
5284                 set x0 [lsearch -exact $previdlist $id]
5285                 set z [expr {$x0 - $col}]
5286                 if {$z0 ne {}} {
5287                     set pprevidlist [lindex $rowidlist $ym]
5288                     set xm [lsearch -exact $pprevidlist $id]
5289                     set z0 [expr {$xm - $x0}]
5290                 }
5291             } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5292                 # Line currently goes right too much;
5293                 # insert pads in this line
5294                 set npad [expr {$z - 1 + $isarrow}]
5295                 insert_pad $row $col $npad
5296                 set idlist [lindex $rowidlist $row]
5297                 incr col $npad
5298                 set z [expr {$x0 - $col}]
5299                 set haspad 1
5300             }
5301             if {$z0 eq {} && !$isarrow && $ym >= 0} {
5302                 # this line links to its first child on row $row-2
5303                 set id [lindex $displayorder $ym]
5304                 set xc [lsearch -exact $pprevidlist $id]
5305                 if {$xc >= 0} {
5306                     set z0 [expr {$xc - $x0}]
5307                 }
5308             }
5309             # avoid lines jigging left then immediately right
5310             if {$z0 ne {} && $z < 0 && $z0 > 0} {
5311                 insert_pad $y0 $x0 1
5312                 incr x0
5313                 optimize_rows $y0 $x0 $row
5314                 set previdlist [lindex $rowidlist $y0]
5315             }
5316         }
5317         if {!$haspad} {
5318             # Find the first column that doesn't have a line going right
5319             for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5320                 set id [lindex $idlist $col]
5321                 if {$id eq {}} break
5322                 set x0 [lsearch -exact $previdlist $id]
5323                 if {$x0 < 0} {
5324                     # check if this is the link to the first child
5325                     set kid [lindex $displayorder $y0]
5326                     if {[lindex $children($curview,$id) 0] eq $kid} {
5327                         # it is, work out offset to child
5328                         set x0 [lsearch -exact $previdlist $kid]
5329                     }
5330                 }
5331                 if {$x0 <= $col} break
5332             }
5333             # Insert a pad at that column as long as it has a line and
5334             # isn't the last column
5335             if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5336                 set idlist [linsert $idlist $col {}]
5337                 lset rowidlist $row $idlist
5338                 changedrow $row
5339             }
5340         }
5341     }
5342 }
5343
5344 proc xc {row col} {
5345     global canvx0 linespc
5346     return [expr {$canvx0 + $col * $linespc}]
5347 }
5348
5349 proc yc {row} {
5350     global canvy0 linespc
5351     return [expr {$canvy0 + $row * $linespc}]
5352 }
5353
5354 proc linewidth {id} {
5355     global thickerline lthickness
5356
5357     set wid $lthickness
5358     if {[info exists thickerline] && $id eq $thickerline} {
5359         set wid [expr {2 * $lthickness}]
5360     }
5361     return $wid
5362 }
5363
5364 proc rowranges {id} {
5365     global curview children uparrowlen downarrowlen
5366     global rowidlist
5367
5368     set kids $children($curview,$id)
5369     if {$kids eq {}} {
5370         return {}
5371     }
5372     set ret {}
5373     lappend kids $id
5374     foreach child $kids {
5375         if {![commitinview $child $curview]} break
5376         set row [rowofcommit $child]
5377         if {![info exists prev]} {
5378             lappend ret [expr {$row + 1}]
5379         } else {
5380             if {$row <= $prevrow} {
5381                 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5382             }
5383             # see if the line extends the whole way from prevrow to row
5384             if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5385                 [lsearch -exact [lindex $rowidlist \
5386                             [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5387                 # it doesn't, see where it ends
5388                 set r [expr {$prevrow + $downarrowlen}]
5389                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5390                     while {[incr r -1] > $prevrow &&
5391                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5392                 } else {
5393                     while {[incr r] <= $row &&
5394                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5395                     incr r -1
5396                 }
5397                 lappend ret $r
5398                 # see where it starts up again
5399                 set r [expr {$row - $uparrowlen}]
5400                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5401                     while {[incr r] < $row &&
5402                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5403                 } else {
5404                     while {[incr r -1] >= $prevrow &&
5405                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5406                     incr r
5407                 }
5408                 lappend ret $r
5409             }
5410         }
5411         if {$child eq $id} {
5412             lappend ret $row
5413         }
5414         set prev $child
5415         set prevrow $row
5416     }
5417     return $ret
5418 }
5419
5420 proc drawlineseg {id row endrow arrowlow} {
5421     global rowidlist displayorder iddrawn linesegs
5422     global canv colormap linespc curview maxlinelen parentlist
5423
5424     set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5425     set le [expr {$row + 1}]
5426     set arrowhigh 1
5427     while {1} {
5428         set c [lsearch -exact [lindex $rowidlist $le] $id]
5429         if {$c < 0} {
5430             incr le -1
5431             break
5432         }
5433         lappend cols $c
5434         set x [lindex $displayorder $le]
5435         if {$x eq $id} {
5436             set arrowhigh 0
5437             break
5438         }
5439         if {[info exists iddrawn($x)] || $le == $endrow} {
5440             set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5441             if {$c >= 0} {
5442                 lappend cols $c
5443                 set arrowhigh 0
5444             }
5445             break
5446         }
5447         incr le
5448     }
5449     if {$le <= $row} {
5450         return $row
5451     }
5452
5453     set lines {}
5454     set i 0
5455     set joinhigh 0
5456     if {[info exists linesegs($id)]} {
5457         set lines $linesegs($id)
5458         foreach li $lines {
5459             set r0 [lindex $li 0]
5460             if {$r0 > $row} {
5461                 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5462                     set joinhigh 1
5463                 }
5464                 break
5465             }
5466             incr i
5467         }
5468     }
5469     set joinlow 0
5470     if {$i > 0} {
5471         set li [lindex $lines [expr {$i-1}]]
5472         set r1 [lindex $li 1]
5473         if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5474             set joinlow 1
5475         }
5476     }
5477
5478     set x [lindex $cols [expr {$le - $row}]]
5479     set xp [lindex $cols [expr {$le - 1 - $row}]]
5480     set dir [expr {$xp - $x}]
5481     if {$joinhigh} {
5482         set ith [lindex $lines $i 2]
5483         set coords [$canv coords $ith]
5484         set ah [$canv itemcget $ith -arrow]
5485         set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5486         set x2 [lindex $cols [expr {$le + 1 - $row}]]
5487         if {$x2 ne {} && $x - $x2 == $dir} {
5488             set coords [lrange $coords 0 end-2]
5489         }
5490     } else {
5491         set coords [list [xc $le $x] [yc $le]]
5492     }
5493     if {$joinlow} {
5494         set itl [lindex $lines [expr {$i-1}] 2]
5495         set al [$canv itemcget $itl -arrow]
5496         set arrowlow [expr {$al eq "last" || $al eq "both"}]
5497     } elseif {$arrowlow} {
5498         if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5499             [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5500             set arrowlow 0
5501         }
5502     }
5503     set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5504     for {set y $le} {[incr y -1] > $row} {} {
5505         set x $xp
5506         set xp [lindex $cols [expr {$y - 1 - $row}]]
5507         set ndir [expr {$xp - $x}]
5508         if {$dir != $ndir || $xp < 0} {
5509             lappend coords [xc $y $x] [yc $y]
5510         }
5511         set dir $ndir
5512     }
5513     if {!$joinlow} {
5514         if {$xp < 0} {
5515             # join parent line to first child
5516             set ch [lindex $displayorder $row]
5517             set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5518             if {$xc < 0} {
5519                 puts "oops: drawlineseg: child $ch not on row $row"
5520             } elseif {$xc != $x} {
5521                 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5522                     set d [expr {int(0.5 * $linespc)}]
5523                     set x1 [xc $row $x]
5524                     if {$xc < $x} {
5525                         set x2 [expr {$x1 - $d}]
5526                     } else {
5527                         set x2 [expr {$x1 + $d}]
5528                     }
5529                     set y2 [yc $row]
5530                     set y1 [expr {$y2 + $d}]
5531                     lappend coords $x1 $y1 $x2 $y2
5532                 } elseif {$xc < $x - 1} {
5533                     lappend coords [xc $row [expr {$x-1}]] [yc $row]
5534                 } elseif {$xc > $x + 1} {
5535                     lappend coords [xc $row [expr {$x+1}]] [yc $row]
5536                 }
5537                 set x $xc
5538             }
5539             lappend coords [xc $row $x] [yc $row]
5540         } else {
5541             set xn [xc $row $xp]
5542             set yn [yc $row]
5543             lappend coords $xn $yn
5544         }
5545         if {!$joinhigh} {
5546             assigncolor $id
5547             set t [$canv create line $coords -width [linewidth $id] \
5548                        -fill $colormap($id) -tags lines.$id -arrow $arrow]
5549             $canv lower $t
5550             bindline $t $id
5551             set lines [linsert $lines $i [list $row $le $t]]
5552         } else {
5553             $canv coords $ith $coords
5554             if {$arrow ne $ah} {
5555                 $canv itemconf $ith -arrow $arrow
5556             }
5557             lset lines $i 0 $row
5558         }
5559     } else {
5560         set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
5561         set ndir [expr {$xo - $xp}]
5562         set clow [$canv coords $itl]
5563         if {$dir == $ndir} {
5564             set clow [lrange $clow 2 end]
5565         }
5566         set coords [concat $coords $clow]
5567         if {!$joinhigh} {
5568             lset lines [expr {$i-1}] 1 $le
5569         } else {
5570             # coalesce two pieces
5571             $canv delete $ith
5572             set b [lindex $lines [expr {$i-1}] 0]
5573             set e [lindex $lines $i 1]
5574             set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
5575         }
5576         $canv coords $itl $coords
5577         if {$arrow ne $al} {
5578             $canv itemconf $itl -arrow $arrow
5579         }
5580     }
5581
5582     set linesegs($id) $lines
5583     return $le
5584 }
5585
5586 proc drawparentlinks {id row} {
5587     global rowidlist canv colormap curview parentlist
5588     global idpos linespc
5589
5590     set rowids [lindex $rowidlist $row]
5591     set col [lsearch -exact $rowids $id]
5592     if {$col < 0} return
5593     set olds [lindex $parentlist $row]
5594     set row2 [expr {$row + 1}]
5595     set x [xc $row $col]
5596     set y [yc $row]
5597     set y2 [yc $row2]
5598     set d [expr {int(0.5 * $linespc)}]
5599     set ymid [expr {$y + $d}]
5600     set ids [lindex $rowidlist $row2]
5601     # rmx = right-most X coord used
5602     set rmx 0
5603     foreach p $olds {
5604         set i [lsearch -exact $ids $p]
5605         if {$i < 0} {
5606             puts "oops, parent $p of $id not in list"
5607             continue
5608         }
5609         set x2 [xc $row2 $i]
5610         if {$x2 > $rmx} {
5611             set rmx $x2
5612         }
5613         set j [lsearch -exact $rowids $p]
5614         if {$j < 0} {
5615             # drawlineseg will do this one for us
5616             continue
5617         }
5618         assigncolor $p
5619         # should handle duplicated parents here...
5620         set coords [list $x $y]
5621         if {$i != $col} {
5622             # if attaching to a vertical segment, draw a smaller
5623             # slant for visual distinctness
5624             if {$i == $j} {
5625                 if {$i < $col} {
5626                     lappend coords [expr {$x2 + $d}] $y $x2 $ymid
5627                 } else {
5628                     lappend coords [expr {$x2 - $d}] $y $x2 $ymid
5629                 }
5630             } elseif {$i < $col && $i < $j} {
5631                 # segment slants towards us already
5632                 lappend coords [xc $row $j] $y
5633             } else {
5634                 if {$i < $col - 1} {
5635                     lappend coords [expr {$x2 + $linespc}] $y
5636                 } elseif {$i > $col + 1} {
5637                     lappend coords [expr {$x2 - $linespc}] $y
5638                 }
5639                 lappend coords $x2 $y2
5640             }
5641         } else {
5642             lappend coords $x2 $y2
5643         }
5644         set t [$canv create line $coords -width [linewidth $p] \
5645                    -fill $colormap($p) -tags lines.$p]
5646         $canv lower $t
5647         bindline $t $p
5648     }
5649     if {$rmx > [lindex $idpos($id) 1]} {
5650         lset idpos($id) 1 $rmx
5651         redrawtags $id
5652     }
5653 }
5654
5655 proc drawlines {id} {
5656     global canv
5657
5658     $canv itemconf lines.$id -width [linewidth $id]
5659 }
5660
5661 proc drawcmittext {id row col} {
5662     global linespc canv canv2 canv3 fgcolor curview
5663     global cmitlisted commitinfo rowidlist parentlist
5664     global rowtextx idpos idtags idheads idotherrefs
5665     global linehtag linentag linedtag selectedline
5666     global canvxmax boldids boldnameids fgcolor markedid
5667     global mainheadid nullid nullid2 circleitem circlecolors ctxbut
5668
5669     # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
5670     set listed $cmitlisted($curview,$id)
5671     if {$id eq $nullid} {
5672         set ofill red
5673     } elseif {$id eq $nullid2} {
5674         set ofill green
5675     } elseif {$id eq $mainheadid} {
5676         set ofill yellow
5677     } else {
5678         set ofill [lindex $circlecolors $listed]
5679     }
5680     set x [xc $row $col]
5681     set y [yc $row]
5682     set orad [expr {$linespc / 3}]
5683     if {$listed <= 2} {
5684         set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
5685                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5686                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
5687     } elseif {$listed == 3} {
5688         # triangle pointing left for left-side commits
5689         set t [$canv create polygon \
5690                    [expr {$x - $orad}] $y \
5691                    [expr {$x + $orad - 1}] [expr {$y - $orad}] \
5692                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5693                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
5694     } else {
5695         # triangle pointing right for right-side commits
5696         set t [$canv create polygon \
5697                    [expr {$x + $orad - 1}] $y \
5698                    [expr {$x - $orad}] [expr {$y - $orad}] \
5699                    [expr {$x - $orad}] [expr {$y + $orad - 1}] \
5700                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
5701     }
5702     set circleitem($row) $t
5703     $canv raise $t
5704     $canv bind $t <1> {selcanvline {} %x %y}
5705     set rmx [llength [lindex $rowidlist $row]]
5706     set olds [lindex $parentlist $row]
5707     if {$olds ne {}} {
5708         set nextids [lindex $rowidlist [expr {$row + 1}]]
5709         foreach p $olds {
5710             set i [lsearch -exact $nextids $p]
5711             if {$i > $rmx} {
5712                 set rmx $i
5713             }
5714         }
5715     }
5716     set xt [xc $row $rmx]
5717     set rowtextx($row) $xt
5718     set idpos($id) [list $x $xt $y]
5719     if {[info exists idtags($id)] || [info exists idheads($id)]
5720         || [info exists idotherrefs($id)]} {
5721         set xt [drawtags $id $x $xt $y]
5722     }
5723     set headline [lindex $commitinfo($id) 0]
5724     set name [lindex $commitinfo($id) 1]
5725     set date [lindex $commitinfo($id) 2]
5726     set date [formatdate $date]
5727     set font mainfont
5728     set nfont mainfont
5729     set isbold [ishighlighted $id]
5730     if {$isbold > 0} {
5731         lappend boldids $id
5732         set font mainfontbold
5733         if {$isbold > 1} {
5734             lappend boldnameids $id
5735             set nfont mainfontbold
5736         }
5737     }
5738     set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
5739                            -text $headline -font $font -tags text]
5740     $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
5741     set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
5742                            -text $name -font $nfont -tags text]
5743     set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
5744                            -text $date -font mainfont -tags text]
5745     if {$selectedline == $row} {
5746         make_secsel $id
5747     }
5748     if {[info exists markedid] && $markedid eq $id} {
5749         make_idmark $id
5750     }
5751     set xr [expr {$xt + [font measure $font $headline]}]
5752     if {$xr > $canvxmax} {
5753         set canvxmax $xr
5754         setcanvscroll
5755     }
5756 }
5757
5758 proc drawcmitrow {row} {
5759     global displayorder rowidlist nrows_drawn
5760     global iddrawn markingmatches
5761     global commitinfo numcommits
5762     global filehighlight fhighlights findpattern nhighlights
5763     global hlview vhighlights
5764     global highlight_related rhighlights
5765
5766     if {$row >= $numcommits} return
5767
5768     set id [lindex $displayorder $row]
5769     if {[info exists hlview] && ![info exists vhighlights($id)]} {
5770         askvhighlight $row $id
5771     }
5772     if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
5773         askfilehighlight $row $id
5774     }
5775     if {$findpattern ne {} && ![info exists nhighlights($id)]} {
5776         askfindhighlight $row $id
5777     }
5778     if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
5779         askrelhighlight $row $id
5780     }
5781     if {![info exists iddrawn($id)]} {
5782         set col [lsearch -exact [lindex $rowidlist $row] $id]
5783         if {$col < 0} {
5784             puts "oops, row $row id $id not in list"
5785             return
5786         }
5787         if {![info exists commitinfo($id)]} {
5788             getcommit $id
5789         }
5790         assigncolor $id
5791         drawcmittext $id $row $col
5792         set iddrawn($id) 1
5793         incr nrows_drawn
5794     }
5795     if {$markingmatches} {
5796         markrowmatches $row $id
5797     }
5798 }
5799
5800 proc drawcommits {row {endrow {}}} {
5801     global numcommits iddrawn displayorder curview need_redisplay
5802     global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
5803
5804     if {$row < 0} {
5805         set row 0
5806     }
5807     if {$endrow eq {}} {
5808         set endrow $row
5809     }
5810     if {$endrow >= $numcommits} {
5811         set endrow [expr {$numcommits - 1}]
5812     }
5813
5814     set rl1 [expr {$row - $downarrowlen - 3}]
5815     if {$rl1 < 0} {
5816         set rl1 0
5817     }
5818     set ro1 [expr {$row - 3}]
5819     if {$ro1 < 0} {
5820         set ro1 0
5821     }
5822     set r2 [expr {$endrow + $uparrowlen + 3}]
5823     if {$r2 > $numcommits} {
5824         set r2 $numcommits
5825     }
5826     for {set r $rl1} {$r < $r2} {incr r} {
5827         if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
5828             if {$rl1 < $r} {
5829                 layoutrows $rl1 $r
5830             }
5831             set rl1 [expr {$r + 1}]
5832         }
5833     }
5834     if {$rl1 < $r} {
5835         layoutrows $rl1 $r
5836     }
5837     optimize_rows $ro1 0 $r2
5838     if {$need_redisplay || $nrows_drawn > 2000} {
5839         clear_display
5840     }
5841
5842     # make the lines join to already-drawn rows either side
5843     set r [expr {$row - 1}]
5844     if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
5845         set r $row
5846     }
5847     set er [expr {$endrow + 1}]
5848     if {$er >= $numcommits ||
5849         ![info exists iddrawn([lindex $displayorder $er])]} {
5850         set er $endrow
5851     }
5852     for {} {$r <= $er} {incr r} {
5853         set id [lindex $displayorder $r]
5854         set wasdrawn [info exists iddrawn($id)]
5855         drawcmitrow $r
5856         if {$r == $er} break
5857         set nextid [lindex $displayorder [expr {$r + 1}]]
5858         if {$wasdrawn && [info exists iddrawn($nextid)]} continue
5859         drawparentlinks $id $r
5860
5861         set rowids [lindex $rowidlist $r]
5862         foreach lid $rowids {
5863             if {$lid eq {}} continue
5864             if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
5865             if {$lid eq $id} {
5866                 # see if this is the first child of any of its parents
5867                 foreach p [lindex $parentlist $r] {
5868                     if {[lsearch -exact $rowids $p] < 0} {
5869                         # make this line extend up to the child
5870                         set lineend($p) [drawlineseg $p $r $er 0]
5871                     }
5872                 }
5873             } else {
5874                 set lineend($lid) [drawlineseg $lid $r $er 1]
5875             }
5876         }
5877     }
5878 }
5879
5880 proc undolayout {row} {
5881     global uparrowlen mingaplen downarrowlen
5882     global rowidlist rowisopt rowfinal need_redisplay
5883
5884     set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
5885     if {$r < 0} {
5886         set r 0
5887     }
5888     if {[llength $rowidlist] > $r} {
5889         incr r -1
5890         set rowidlist [lrange $rowidlist 0 $r]
5891         set rowfinal [lrange $rowfinal 0 $r]
5892         set rowisopt [lrange $rowisopt 0 $r]
5893         set need_redisplay 1
5894         run drawvisible
5895     }
5896 }
5897
5898 proc drawvisible {} {
5899     global canv linespc curview vrowmod selectedline targetrow targetid
5900     global need_redisplay cscroll numcommits
5901
5902     set fs [$canv yview]
5903     set ymax [lindex [$canv cget -scrollregion] 3]
5904     if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
5905     set f0 [lindex $fs 0]
5906     set f1 [lindex $fs 1]
5907     set y0 [expr {int($f0 * $ymax)}]
5908     set y1 [expr {int($f1 * $ymax)}]
5909
5910     if {[info exists targetid]} {
5911         if {[commitinview $targetid $curview]} {
5912             set r [rowofcommit $targetid]
5913             if {$r != $targetrow} {
5914                 # Fix up the scrollregion and change the scrolling position
5915                 # now that our target row has moved.
5916                 set diff [expr {($r - $targetrow) * $linespc}]
5917                 set targetrow $r
5918                 setcanvscroll
5919                 set ymax [lindex [$canv cget -scrollregion] 3]
5920                 incr y0 $diff
5921                 incr y1 $diff
5922                 set f0 [expr {$y0 / $ymax}]
5923                 set f1 [expr {$y1 / $ymax}]
5924                 allcanvs yview moveto $f0
5925                 $cscroll set $f0 $f1
5926                 set need_redisplay 1
5927             }
5928         } else {
5929             unset targetid
5930         }
5931     }
5932
5933     set row [expr {int(($y0 - 3) / $linespc) - 1}]
5934     set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
5935     if {$endrow >= $vrowmod($curview)} {
5936         update_arcrows $curview
5937     }
5938     if {$selectedline ne {} &&
5939         $row <= $selectedline && $selectedline <= $endrow} {
5940         set targetrow $selectedline
5941     } elseif {[info exists targetid]} {
5942         set targetrow [expr {int(($row + $endrow) / 2)}]
5943     }
5944     if {[info exists targetrow]} {
5945         if {$targetrow >= $numcommits} {
5946             set targetrow [expr {$numcommits - 1}]
5947         }
5948         set targetid [commitonrow $targetrow]
5949     }
5950     drawcommits $row $endrow
5951 }
5952
5953 proc clear_display {} {
5954     global iddrawn linesegs need_redisplay nrows_drawn
5955     global vhighlights fhighlights nhighlights rhighlights
5956     global linehtag linentag linedtag boldids boldnameids
5957
5958     allcanvs delete all
5959     catch {unset iddrawn}
5960     catch {unset linesegs}
5961     catch {unset linehtag}
5962     catch {unset linentag}
5963     catch {unset linedtag}
5964     set boldids {}
5965     set boldnameids {}
5966     catch {unset vhighlights}
5967     catch {unset fhighlights}
5968     catch {unset nhighlights}
5969     catch {unset rhighlights}
5970     set need_redisplay 0
5971     set nrows_drawn 0
5972 }
5973
5974 proc findcrossings {id} {
5975     global rowidlist parentlist numcommits displayorder
5976
5977     set cross {}
5978     set ccross {}
5979     foreach {s e} [rowranges $id] {
5980         if {$e >= $numcommits} {
5981             set e [expr {$numcommits - 1}]
5982         }
5983         if {$e <= $s} continue
5984         for {set row $e} {[incr row -1] >= $s} {} {
5985             set x [lsearch -exact [lindex $rowidlist $row] $id]
5986             if {$x < 0} break
5987             set olds [lindex $parentlist $row]
5988             set kid [lindex $displayorder $row]
5989             set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
5990             if {$kidx < 0} continue
5991             set nextrow [lindex $rowidlist [expr {$row + 1}]]
5992             foreach p $olds {
5993                 set px [lsearch -exact $nextrow $p]
5994                 if {$px < 0} continue
5995                 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
5996                     if {[lsearch -exact $ccross $p] >= 0} continue
5997                     if {$x == $px + ($kidx < $px? -1: 1)} {
5998                         lappend ccross $p
5999                     } elseif {[lsearch -exact $cross $p] < 0} {
6000                         lappend cross $p
6001                     }
6002                 }
6003             }
6004         }
6005     }
6006     return [concat $ccross {{}} $cross]
6007 }
6008
6009 proc assigncolor {id} {
6010     global colormap colors nextcolor
6011     global parents children children curview
6012
6013     if {[info exists colormap($id)]} return
6014     set ncolors [llength $colors]
6015     if {[info exists children($curview,$id)]} {
6016         set kids $children($curview,$id)
6017     } else {
6018         set kids {}
6019     }
6020     if {[llength $kids] == 1} {
6021         set child [lindex $kids 0]
6022         if {[info exists colormap($child)]
6023             && [llength $parents($curview,$child)] == 1} {
6024             set colormap($id) $colormap($child)
6025             return
6026         }
6027     }
6028     set badcolors {}
6029     set origbad {}
6030     foreach x [findcrossings $id] {
6031         if {$x eq {}} {
6032             # delimiter between corner crossings and other crossings
6033             if {[llength $badcolors] >= $ncolors - 1} break
6034             set origbad $badcolors
6035         }
6036         if {[info exists colormap($x)]
6037             && [lsearch -exact $badcolors $colormap($x)] < 0} {
6038             lappend badcolors $colormap($x)
6039         }
6040     }
6041     if {[llength $badcolors] >= $ncolors} {
6042         set badcolors $origbad
6043     }
6044     set origbad $badcolors
6045     if {[llength $badcolors] < $ncolors - 1} {
6046         foreach child $kids {
6047             if {[info exists colormap($child)]
6048                 && [lsearch -exact $badcolors $colormap($child)] < 0} {
6049                 lappend badcolors $colormap($child)
6050             }
6051             foreach p $parents($curview,$child) {
6052                 if {[info exists colormap($p)]
6053                     && [lsearch -exact $badcolors $colormap($p)] < 0} {
6054                     lappend badcolors $colormap($p)
6055                 }
6056             }
6057         }
6058         if {[llength $badcolors] >= $ncolors} {
6059             set badcolors $origbad
6060         }
6061     }
6062     for {set i 0} {$i <= $ncolors} {incr i} {
6063         set c [lindex $colors $nextcolor]
6064         if {[incr nextcolor] >= $ncolors} {
6065             set nextcolor 0
6066         }
6067         if {[lsearch -exact $badcolors $c]} break
6068     }
6069     set colormap($id) $c
6070 }
6071
6072 proc bindline {t id} {
6073     global canv
6074
6075     $canv bind $t <Enter> "lineenter %x %y $id"
6076     $canv bind $t <Motion> "linemotion %x %y $id"
6077     $canv bind $t <Leave> "lineleave $id"
6078     $canv bind $t <Button-1> "lineclick %x %y $id 1"
6079 }
6080
6081 proc drawtags {id x xt y1} {
6082     global idtags idheads idotherrefs mainhead
6083     global linespc lthickness
6084     global canv rowtextx curview fgcolor bgcolor ctxbut
6085
6086     set marks {}
6087     set ntags 0
6088     set nheads 0
6089     if {[info exists idtags($id)]} {
6090         set marks $idtags($id)
6091         set ntags [llength $marks]
6092     }
6093     if {[info exists idheads($id)]} {
6094         set marks [concat $marks $idheads($id)]
6095         set nheads [llength $idheads($id)]
6096     }
6097     if {[info exists idotherrefs($id)]} {
6098         set marks [concat $marks $idotherrefs($id)]
6099     }
6100     if {$marks eq {}} {
6101         return $xt
6102     }
6103
6104     set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6105     set yt [expr {$y1 - 0.5 * $linespc}]
6106     set yb [expr {$yt + $linespc - 1}]
6107     set xvals {}
6108     set wvals {}
6109     set i -1
6110     foreach tag $marks {
6111         incr i
6112         if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
6113             set wid [font measure mainfontbold $tag]
6114         } else {
6115             set wid [font measure mainfont $tag]
6116         }
6117         lappend xvals $xt
6118         lappend wvals $wid
6119         set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
6120     }
6121     set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
6122                -width $lthickness -fill black -tags tag.$id]
6123     $canv lower $t
6124     foreach tag $marks x $xvals wid $wvals {
6125         set xl [expr {$x + $delta}]
6126         set xr [expr {$x + $delta + $wid + $lthickness}]
6127         set font mainfont
6128         if {[incr ntags -1] >= 0} {
6129             # draw a tag
6130             set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6131                        $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
6132                        -width 1 -outline black -fill yellow -tags tag.$id]
6133             $canv bind $t <1> [list showtag $tag 1]
6134             set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
6135         } else {
6136             # draw a head or other ref
6137             if {[incr nheads -1] >= 0} {
6138                 set col green
6139                 if {$tag eq $mainhead} {
6140                     set font mainfontbold
6141                 }
6142             } else {
6143                 set col "#ddddff"
6144             }
6145             set xl [expr {$xl - $delta/2}]
6146             $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
6147                 -width 1 -outline black -fill $col -tags tag.$id
6148             if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
6149                 set rwid [font measure mainfont $remoteprefix]
6150                 set xi [expr {$x + 1}]
6151                 set yti [expr {$yt + 1}]
6152                 set xri [expr {$x + $rwid}]
6153                 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6154                         -width 0 -fill "#ffddaa" -tags tag.$id
6155             }
6156         }
6157         set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
6158                    -font $font -tags [list tag.$id text]]
6159         if {$ntags >= 0} {
6160             $canv bind $t <1> [list showtag $tag 1]
6161         } elseif {$nheads >= 0} {
6162             $canv bind $t $ctxbut [list headmenu %X %Y $id $tag]
6163         }
6164     }
6165     return $xt
6166 }
6167
6168 proc xcoord {i level ln} {
6169     global canvx0 xspc1 xspc2
6170
6171     set x [expr {$canvx0 + $i * $xspc1($ln)}]
6172     if {$i > 0 && $i == $level} {
6173         set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6174     } elseif {$i > $level} {
6175         set x [expr {$x + $xspc2 - $xspc1($ln)}]
6176     }
6177     return $x
6178 }
6179
6180 proc show_status {msg} {
6181     global canv fgcolor
6182
6183     clear_display
6184     $canv create text 3 3 -anchor nw -text $msg -font mainfont \
6185         -tags text -fill $fgcolor
6186 }
6187
6188 # Don't change the text pane cursor if it is currently the hand cursor,
6189 # showing that we are over a sha1 ID link.
6190 proc settextcursor {c} {
6191     global ctext curtextcursor
6192
6193     if {[$ctext cget -cursor] == $curtextcursor} {
6194         $ctext config -cursor $c
6195     }
6196     set curtextcursor $c
6197 }
6198
6199 proc nowbusy {what {name {}}} {
6200     global isbusy busyname statusw
6201
6202     if {[array names isbusy] eq {}} {
6203         . config -cursor watch
6204         settextcursor watch
6205     }
6206     set isbusy($what) 1
6207     set busyname($what) $name
6208     if {$name ne {}} {
6209         $statusw conf -text $name
6210     }
6211 }
6212
6213 proc notbusy {what} {
6214     global isbusy maincursor textcursor busyname statusw
6215
6216     catch {
6217         unset isbusy($what)
6218         if {$busyname($what) ne {} &&
6219             [$statusw cget -text] eq $busyname($what)} {
6220             $statusw conf -text {}
6221         }
6222     }
6223     if {[array names isbusy] eq {}} {
6224         . config -cursor $maincursor
6225         settextcursor $textcursor
6226     }
6227 }
6228
6229 proc findmatches {f} {
6230     global findtype findstring
6231     if {$findtype == [mc "Regexp"]} {
6232         set matches [regexp -indices -all -inline $findstring $f]
6233     } else {
6234         set fs $findstring
6235         if {$findtype == [mc "IgnCase"]} {
6236             set f [string tolower $f]
6237             set fs [string tolower $fs]
6238         }
6239         set matches {}
6240         set i 0
6241         set l [string length $fs]
6242         while {[set j [string first $fs $f $i]] >= 0} {
6243             lappend matches [list $j [expr {$j+$l-1}]]
6244             set i [expr {$j + $l}]
6245         }
6246     }
6247     return $matches
6248 }
6249
6250 proc dofind {{dirn 1} {wrap 1}} {
6251     global findstring findstartline findcurline selectedline numcommits
6252     global gdttype filehighlight fh_serial find_dirn findallowwrap
6253
6254     if {[info exists find_dirn]} {
6255         if {$find_dirn == $dirn} return
6256         stopfinding
6257     }
6258     focus .
6259     if {$findstring eq {} || $numcommits == 0} return
6260     if {$selectedline eq {}} {
6261         set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6262     } else {
6263         set findstartline $selectedline
6264     }
6265     set findcurline $findstartline
6266     nowbusy finding [mc "Searching"]
6267     if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6268         after cancel do_file_hl $fh_serial
6269         do_file_hl $fh_serial
6270     }
6271     set find_dirn $dirn
6272     set findallowwrap $wrap
6273     run findmore
6274 }
6275
6276 proc stopfinding {} {
6277     global find_dirn findcurline fprogcoord
6278
6279     if {[info exists find_dirn]} {
6280         unset find_dirn
6281         unset findcurline
6282         notbusy finding
6283         set fprogcoord 0
6284         adjustprogress
6285     }
6286     stopblaming
6287 }
6288
6289 proc findmore {} {
6290     global commitdata commitinfo numcommits findpattern findloc
6291     global findstartline findcurline findallowwrap
6292     global find_dirn gdttype fhighlights fprogcoord
6293     global curview varcorder vrownum varccommits vrowmod
6294
6295     if {![info exists find_dirn]} {
6296         return 0
6297     }
6298     set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
6299     set l $findcurline
6300     set moretodo 0
6301     if {$find_dirn > 0} {
6302         incr l
6303         if {$l >= $numcommits} {
6304             set l 0
6305         }
6306         if {$l <= $findstartline} {
6307             set lim [expr {$findstartline + 1}]
6308         } else {
6309             set lim $numcommits
6310             set moretodo $findallowwrap
6311         }
6312     } else {
6313         if {$l == 0} {
6314             set l $numcommits
6315         }
6316         incr l -1
6317         if {$l >= $findstartline} {
6318             set lim [expr {$findstartline - 1}]
6319         } else {
6320             set lim -1
6321             set moretodo $findallowwrap
6322         }
6323     }
6324     set n [expr {($lim - $l) * $find_dirn}]
6325     if {$n > 500} {
6326         set n 500
6327         set moretodo 1
6328     }
6329     if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6330         update_arcrows $curview
6331     }
6332     set found 0
6333     set domore 1
6334     set ai [bsearch $vrownum($curview) $l]
6335     set a [lindex $varcorder($curview) $ai]
6336     set arow [lindex $vrownum($curview) $ai]
6337     set ids [lindex $varccommits($curview,$a)]
6338     set arowend [expr {$arow + [llength $ids]}]
6339     if {$gdttype eq [mc "containing:"]} {
6340         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6341             if {$l < $arow || $l >= $arowend} {
6342                 incr ai $find_dirn
6343                 set a [lindex $varcorder($curview) $ai]
6344                 set arow [lindex $vrownum($curview) $ai]
6345                 set ids [lindex $varccommits($curview,$a)]
6346                 set arowend [expr {$arow + [llength $ids]}]
6347             }
6348             set id [lindex $ids [expr {$l - $arow}]]
6349             # shouldn't happen unless git log doesn't give all the commits...
6350             if {![info exists commitdata($id)] ||
6351                 ![doesmatch $commitdata($id)]} {
6352                 continue
6353             }
6354             if {![info exists commitinfo($id)]} {
6355                 getcommit $id
6356             }
6357             set info $commitinfo($id)
6358             foreach f $info ty $fldtypes {
6359                 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6360                     [doesmatch $f]} {
6361                     set found 1
6362                     break
6363                 }
6364             }
6365             if {$found} break
6366         }
6367     } else {
6368         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6369             if {$l < $arow || $l >= $arowend} {
6370                 incr ai $find_dirn
6371                 set a [lindex $varcorder($curview) $ai]
6372                 set arow [lindex $vrownum($curview) $ai]
6373                 set ids [lindex $varccommits($curview,$a)]
6374                 set arowend [expr {$arow + [llength $ids]}]
6375             }
6376             set id [lindex $ids [expr {$l - $arow}]]
6377             if {![info exists fhighlights($id)]} {
6378                 # this sets fhighlights($id) to -1
6379                 askfilehighlight $l $id
6380             }
6381             if {$fhighlights($id) > 0} {
6382                 set found $domore
6383                 break
6384             }
6385             if {$fhighlights($id) < 0} {
6386                 if {$domore} {
6387                     set domore 0
6388                     set findcurline [expr {$l - $find_dirn}]
6389                 }
6390             }
6391         }
6392     }
6393     if {$found || ($domore && !$moretodo)} {
6394         unset findcurline
6395         unset find_dirn
6396         notbusy finding
6397         set fprogcoord 0
6398         adjustprogress
6399         if {$found} {
6400             findselectline $l
6401         } else {
6402             bell
6403         }
6404         return 0
6405     }
6406     if {!$domore} {
6407         flushhighlights
6408     } else {
6409         set findcurline [expr {$l - $find_dirn}]
6410     }
6411     set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6412     if {$n < 0} {
6413         incr n $numcommits
6414     }
6415     set fprogcoord [expr {$n * 1.0 / $numcommits}]
6416     adjustprogress
6417     return $domore
6418 }
6419
6420 proc findselectline {l} {
6421     global findloc commentend ctext findcurline markingmatches gdttype
6422
6423     set markingmatches [expr {$gdttype eq [mc "containing:"]}]
6424     set findcurline $l
6425     selectline $l 1
6426     if {$markingmatches &&
6427         ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
6428         # highlight the matches in the comments
6429         set f [$ctext get 1.0 $commentend]
6430         set matches [findmatches $f]
6431         foreach match $matches {
6432             set start [lindex $match 0]
6433             set end [expr {[lindex $match 1] + 1}]
6434             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6435         }
6436     }
6437     drawvisible
6438 }
6439
6440 # mark the bits of a headline or author that match a find string
6441 proc markmatches {canv l str tag matches font row} {
6442     global selectedline
6443
6444     set bbox [$canv bbox $tag]
6445     set x0 [lindex $bbox 0]
6446     set y0 [lindex $bbox 1]
6447     set y1 [lindex $bbox 3]
6448     foreach match $matches {
6449         set start [lindex $match 0]
6450         set end [lindex $match 1]
6451         if {$start > $end} continue
6452         set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6453         set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6454         set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6455                    [expr {$x0+$xlen+2}] $y1 \
6456                    -outline {} -tags [list match$l matches] -fill yellow]
6457         $canv lower $t
6458         if {$row == $selectedline} {
6459             $canv raise $t secsel
6460         }
6461     }
6462 }
6463
6464 proc unmarkmatches {} {
6465     global markingmatches
6466
6467     allcanvs delete matches
6468     set markingmatches 0
6469     stopfinding
6470 }
6471
6472 proc selcanvline {w x y} {
6473     global canv canvy0 ctext linespc
6474     global rowtextx
6475     set ymax [lindex [$canv cget -scrollregion] 3]
6476     if {$ymax == {}} return
6477     set yfrac [lindex [$canv yview] 0]
6478     set y [expr {$y + $yfrac * $ymax}]
6479     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6480     if {$l < 0} {
6481         set l 0
6482     }
6483     if {$w eq $canv} {
6484         set xmax [lindex [$canv cget -scrollregion] 2]
6485         set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6486         if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
6487     }
6488     unmarkmatches
6489     selectline $l 1
6490 }
6491
6492 proc commit_descriptor {p} {
6493     global commitinfo
6494     if {![info exists commitinfo($p)]} {
6495         getcommit $p
6496     }
6497     set l "..."
6498     if {[llength $commitinfo($p)] > 1} {
6499         set l [lindex $commitinfo($p) 0]
6500     }
6501     return "$p ($l)\n"
6502 }
6503
6504 # append some text to the ctext widget, and make any SHA1 ID
6505 # that we know about be a clickable link.
6506 proc appendwithlinks {text tags} {
6507     global ctext linknum curview
6508
6509     set start [$ctext index "end - 1c"]
6510     $ctext insert end $text $tags
6511     set links [regexp -indices -all -inline {\m[0-9a-f]{6,40}\M} $text]
6512     foreach l $links {
6513         set s [lindex $l 0]
6514         set e [lindex $l 1]
6515         set linkid [string range $text $s $e]
6516         incr e
6517         $ctext tag delete link$linknum
6518         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
6519         setlink $linkid link$linknum
6520         incr linknum
6521     }
6522 }
6523
6524 proc setlink {id lk} {
6525     global curview ctext pendinglinks
6526
6527     set known 0
6528     if {[string length $id] < 40} {
6529         set matches [longid $id]
6530         if {[llength $matches] > 0} {
6531             if {[llength $matches] > 1} return
6532             set known 1
6533             set id [lindex $matches 0]
6534         }
6535     } else {
6536         set known [commitinview $id $curview]
6537     }
6538     if {$known} {
6539         $ctext tag conf $lk -foreground blue -underline 1
6540         $ctext tag bind $lk <1> [list selbyid $id]
6541         $ctext tag bind $lk <Enter> {linkcursor %W 1}
6542         $ctext tag bind $lk <Leave> {linkcursor %W -1}
6543     } else {
6544         lappend pendinglinks($id) $lk
6545         interestedin $id {makelink %P}
6546     }
6547 }
6548
6549 proc appendshortlink {id {pre {}} {post {}}} {
6550     global ctext linknum
6551
6552     $ctext insert end $pre
6553     $ctext tag delete link$linknum
6554     $ctext insert end [string range $id 0 7] link$linknum
6555     $ctext insert end $post
6556     setlink $id link$linknum
6557     incr linknum
6558 }
6559
6560 proc makelink {id} {
6561     global pendinglinks
6562
6563     if {![info exists pendinglinks($id)]} return
6564     foreach lk $pendinglinks($id) {
6565         setlink $id $lk
6566     }
6567     unset pendinglinks($id)
6568 }
6569
6570 proc linkcursor {w inc} {
6571     global linkentercount curtextcursor
6572
6573     if {[incr linkentercount $inc] > 0} {
6574         $w configure -cursor hand2
6575     } else {
6576         $w configure -cursor $curtextcursor
6577         if {$linkentercount < 0} {
6578             set linkentercount 0
6579         }
6580     }
6581 }
6582
6583 proc viewnextline {dir} {
6584     global canv linespc
6585
6586     $canv delete hover
6587     set ymax [lindex [$canv cget -scrollregion] 3]
6588     set wnow [$canv yview]
6589     set wtop [expr {[lindex $wnow 0] * $ymax}]
6590     set newtop [expr {$wtop + $dir * $linespc}]
6591     if {$newtop < 0} {
6592         set newtop 0
6593     } elseif {$newtop > $ymax} {
6594         set newtop $ymax
6595     }
6596     allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6597 }
6598
6599 # add a list of tag or branch names at position pos
6600 # returns the number of names inserted
6601 proc appendrefs {pos ids var} {
6602     global ctext linknum curview $var maxrefs
6603
6604     if {[catch {$ctext index $pos}]} {
6605         return 0
6606     }
6607     $ctext conf -state normal
6608     $ctext delete $pos "$pos lineend"
6609     set tags {}
6610     foreach id $ids {
6611         foreach tag [set $var\($id\)] {
6612             lappend tags [list $tag $id]
6613         }
6614     }
6615     if {[llength $tags] > $maxrefs} {
6616         $ctext insert $pos "[mc "many"] ([llength $tags])"
6617     } else {
6618         set tags [lsort -index 0 -decreasing $tags]
6619         set sep {}
6620         foreach ti $tags {
6621             set id [lindex $ti 1]
6622             set lk link$linknum
6623             incr linknum
6624             $ctext tag delete $lk
6625             $ctext insert $pos $sep
6626             $ctext insert $pos [lindex $ti 0] $lk
6627             setlink $id $lk
6628             set sep ", "
6629         }
6630     }
6631     $ctext conf -state disabled
6632     return [llength $tags]
6633 }
6634
6635 # called when we have finished computing the nearby tags
6636 proc dispneartags {delay} {
6637     global selectedline currentid showneartags tagphase
6638
6639     if {$selectedline eq {} || !$showneartags} return
6640     after cancel dispnexttag
6641     if {$delay} {
6642         after 200 dispnexttag
6643         set tagphase -1
6644     } else {
6645         after idle dispnexttag
6646         set tagphase 0
6647     }
6648 }
6649
6650 proc dispnexttag {} {
6651     global selectedline currentid showneartags tagphase ctext
6652
6653     if {$selectedline eq {} || !$showneartags} return
6654     switch -- $tagphase {
6655         0 {
6656             set dtags [desctags $currentid]
6657             if {$dtags ne {}} {
6658                 appendrefs precedes $dtags idtags
6659             }
6660         }
6661         1 {
6662             set atags [anctags $currentid]
6663             if {$atags ne {}} {
6664                 appendrefs follows $atags idtags
6665             }
6666         }
6667         2 {
6668             set dheads [descheads $currentid]
6669             if {$dheads ne {}} {
6670                 if {[appendrefs branch $dheads idheads] > 1
6671                     && [$ctext get "branch -3c"] eq "h"} {
6672                     # turn "Branch" into "Branches"
6673                     $ctext conf -state normal
6674                     $ctext insert "branch -2c" "es"
6675                     $ctext conf -state disabled
6676                 }
6677             }
6678         }
6679     }
6680     if {[incr tagphase] <= 2} {
6681         after idle dispnexttag
6682     }
6683 }
6684
6685 proc make_secsel {id} {
6686     global linehtag linentag linedtag canv canv2 canv3
6687
6688     if {![info exists linehtag($id)]} return
6689     $canv delete secsel
6690     set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
6691                -tags secsel -fill [$canv cget -selectbackground]]
6692     $canv lower $t
6693     $canv2 delete secsel
6694     set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
6695                -tags secsel -fill [$canv2 cget -selectbackground]]
6696     $canv2 lower $t
6697     $canv3 delete secsel
6698     set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
6699                -tags secsel -fill [$canv3 cget -selectbackground]]
6700     $canv3 lower $t
6701 }
6702
6703 proc make_idmark {id} {
6704     global linehtag canv fgcolor
6705
6706     if {![info exists linehtag($id)]} return
6707     $canv delete markid
6708     set t [eval $canv create rect [$canv bbox $linehtag($id)] \
6709                -tags markid -outline $fgcolor]
6710     $canv raise $t
6711 }
6712
6713 proc selectline {l isnew {desired_loc {}}} {
6714     global canv ctext commitinfo selectedline
6715     global canvy0 linespc parents children curview
6716     global currentid sha1entry
6717     global commentend idtags linknum
6718     global mergemax numcommits pending_select
6719     global cmitmode showneartags allcommits
6720     global targetrow targetid lastscrollrows
6721     global autoselect jump_to_here
6722
6723     catch {unset pending_select}
6724     $canv delete hover
6725     normalline
6726     unsel_reflist
6727     stopfinding
6728     if {$l < 0 || $l >= $numcommits} return
6729     set id [commitonrow $l]
6730     set targetid $id
6731     set targetrow $l
6732     set selectedline $l
6733     set currentid $id
6734     if {$lastscrollrows < $numcommits} {
6735         setcanvscroll
6736     }
6737
6738     set y [expr {$canvy0 + $l * $linespc}]
6739     set ymax [lindex [$canv cget -scrollregion] 3]
6740     set ytop [expr {$y - $linespc - 1}]
6741     set ybot [expr {$y + $linespc + 1}]
6742     set wnow [$canv yview]
6743     set wtop [expr {[lindex $wnow 0] * $ymax}]
6744     set wbot [expr {[lindex $wnow 1] * $ymax}]
6745     set wh [expr {$wbot - $wtop}]
6746     set newtop $wtop
6747     if {$ytop < $wtop} {
6748         if {$ybot < $wtop} {
6749             set newtop [expr {$y - $wh / 2.0}]
6750         } else {
6751             set newtop $ytop
6752             if {$newtop > $wtop - $linespc} {
6753                 set newtop [expr {$wtop - $linespc}]
6754             }
6755         }
6756     } elseif {$ybot > $wbot} {
6757         if {$ytop > $wbot} {
6758             set newtop [expr {$y - $wh / 2.0}]
6759         } else {
6760             set newtop [expr {$ybot - $wh}]
6761             if {$newtop < $wtop + $linespc} {
6762                 set newtop [expr {$wtop + $linespc}]
6763             }
6764         }
6765     }
6766     if {$newtop != $wtop} {
6767         if {$newtop < 0} {
6768             set newtop 0
6769         }
6770         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6771         drawvisible
6772     }
6773
6774     make_secsel $id
6775
6776     if {$isnew} {
6777         addtohistory [list selbyid $id]
6778     }
6779
6780     $sha1entry delete 0 end
6781     $sha1entry insert 0 $id
6782     if {$autoselect} {
6783         $sha1entry selection from 0
6784         $sha1entry selection to end
6785     }
6786     rhighlight_sel $id
6787
6788     $ctext conf -state normal
6789     clear_ctext
6790     set linknum 0
6791     if {![info exists commitinfo($id)]} {
6792         getcommit $id
6793     }
6794     set info $commitinfo($id)
6795     set date [formatdate [lindex $info 2]]
6796     $ctext insert end "[mc "Author"]: [lindex $info 1]  $date\n"
6797     set date [formatdate [lindex $info 4]]
6798     $ctext insert end "[mc "Committer"]: [lindex $info 3]  $date\n"
6799     if {[info exists idtags($id)]} {
6800         $ctext insert end [mc "Tags:"]
6801         foreach tag $idtags($id) {
6802             $ctext insert end " $tag"
6803         }
6804         $ctext insert end "\n"
6805     }
6806
6807     set headers {}
6808     set olds $parents($curview,$id)
6809     if {[llength $olds] > 1} {
6810         set np 0
6811         foreach p $olds {
6812             if {$np >= $mergemax} {
6813                 set tag mmax
6814             } else {
6815                 set tag m$np
6816             }
6817             $ctext insert end "[mc "Parent"]: " $tag
6818             appendwithlinks [commit_descriptor $p] {}
6819             incr np
6820         }
6821     } else {
6822         foreach p $olds {
6823             append headers "[mc "Parent"]: [commit_descriptor $p]"
6824         }
6825     }
6826
6827     foreach c $children($curview,$id) {
6828         append headers "[mc "Child"]:  [commit_descriptor $c]"
6829     }
6830
6831     # make anything that looks like a SHA1 ID be a clickable link
6832     appendwithlinks $headers {}
6833     if {$showneartags} {
6834         if {![info exists allcommits]} {
6835             getallcommits
6836         }
6837         $ctext insert end "[mc "Branch"]: "
6838         $ctext mark set branch "end -1c"
6839         $ctext mark gravity branch left
6840         $ctext insert end "\n[mc "Follows"]: "
6841         $ctext mark set follows "end -1c"
6842         $ctext mark gravity follows left
6843         $ctext insert end "\n[mc "Precedes"]: "
6844         $ctext mark set precedes "end -1c"
6845         $ctext mark gravity precedes left
6846         $ctext insert end "\n"
6847         dispneartags 1
6848     }
6849     $ctext insert end "\n"
6850     set comment [lindex $info 5]
6851     if {[string first "\r" $comment] >= 0} {
6852         set comment [string map {"\r" "\n    "} $comment]
6853     }
6854     appendwithlinks $comment {comment}
6855
6856     $ctext tag remove found 1.0 end
6857     $ctext conf -state disabled
6858     set commentend [$ctext index "end - 1c"]
6859
6860     set jump_to_here $desired_loc
6861     init_flist [mc "Comments"]
6862     if {$cmitmode eq "tree"} {
6863         gettree $id
6864     } elseif {[llength $olds] <= 1} {
6865         startdiff $id
6866     } else {
6867         mergediff $id
6868     }
6869 }
6870
6871 proc selfirstline {} {
6872     unmarkmatches
6873     selectline 0 1
6874 }
6875
6876 proc sellastline {} {
6877     global numcommits
6878     unmarkmatches
6879     set l [expr {$numcommits - 1}]
6880     selectline $l 1
6881 }
6882
6883 proc selnextline {dir} {
6884     global selectedline
6885     focus .
6886     if {$selectedline eq {}} return
6887     set l [expr {$selectedline + $dir}]
6888     unmarkmatches
6889     selectline $l 1
6890 }
6891
6892 proc selnextpage {dir} {
6893     global canv linespc selectedline numcommits
6894
6895     set lpp [expr {([winfo height $canv] - 2) / $linespc}]
6896     if {$lpp < 1} {
6897         set lpp 1
6898     }
6899     allcanvs yview scroll [expr {$dir * $lpp}] units
6900     drawvisible
6901     if {$selectedline eq {}} return
6902     set l [expr {$selectedline + $dir * $lpp}]
6903     if {$l < 0} {
6904         set l 0
6905     } elseif {$l >= $numcommits} {
6906         set l [expr $numcommits - 1]
6907     }
6908     unmarkmatches
6909     selectline $l 1
6910 }
6911
6912 proc unselectline {} {
6913     global selectedline currentid
6914
6915     set selectedline {}
6916     catch {unset currentid}
6917     allcanvs delete secsel
6918     rhighlight_none
6919 }
6920
6921 proc reselectline {} {
6922     global selectedline
6923
6924     if {$selectedline ne {}} {
6925         selectline $selectedline 0
6926     }
6927 }
6928
6929 proc addtohistory {cmd} {
6930     global history historyindex curview
6931
6932     set elt [list $curview $cmd]
6933     if {$historyindex > 0
6934         && [lindex $history [expr {$historyindex - 1}]] == $elt} {
6935         return
6936     }
6937
6938     if {$historyindex < [llength $history]} {
6939         set history [lreplace $history $historyindex end $elt]
6940     } else {
6941         lappend history $elt
6942     }
6943     incr historyindex
6944     if {$historyindex > 1} {
6945         .tf.bar.leftbut conf -state normal
6946     } else {
6947         .tf.bar.leftbut conf -state disabled
6948     }
6949     .tf.bar.rightbut conf -state disabled
6950 }
6951
6952 proc godo {elt} {
6953     global curview
6954
6955     set view [lindex $elt 0]
6956     set cmd [lindex $elt 1]
6957     if {$curview != $view} {
6958         showview $view
6959     }
6960     eval $cmd
6961 }
6962
6963 proc goback {} {
6964     global history historyindex
6965     focus .
6966
6967     if {$historyindex > 1} {
6968         incr historyindex -1
6969         godo [lindex $history [expr {$historyindex - 1}]]
6970         .tf.bar.rightbut conf -state normal
6971     }
6972     if {$historyindex <= 1} {
6973         .tf.bar.leftbut conf -state disabled
6974     }
6975 }
6976
6977 proc goforw {} {
6978     global history historyindex
6979     focus .
6980
6981     if {$historyindex < [llength $history]} {
6982         set cmd [lindex $history $historyindex]
6983         incr historyindex
6984         godo $cmd
6985         .tf.bar.leftbut conf -state normal
6986     }
6987     if {$historyindex >= [llength $history]} {
6988         .tf.bar.rightbut conf -state disabled
6989     }
6990 }
6991
6992 proc gettree {id} {
6993     global treefilelist treeidlist diffids diffmergeid treepending
6994     global nullid nullid2
6995
6996     set diffids $id
6997     catch {unset diffmergeid}
6998     if {![info exists treefilelist($id)]} {
6999         if {![info exists treepending]} {
7000             if {$id eq $nullid} {
7001                 set cmd [list | git ls-files]
7002             } elseif {$id eq $nullid2} {
7003                 set cmd [list | git ls-files --stage -t]
7004             } else {
7005                 set cmd [list | git ls-tree -r $id]
7006             }
7007             if {[catch {set gtf [open $cmd r]}]} {
7008                 return
7009             }
7010             set treepending $id
7011             set treefilelist($id) {}
7012             set treeidlist($id) {}
7013             fconfigure $gtf -blocking 0 -encoding binary
7014             filerun $gtf [list gettreeline $gtf $id]
7015         }
7016     } else {
7017         setfilelist $id
7018     }
7019 }
7020
7021 proc gettreeline {gtf id} {
7022     global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
7023
7024     set nl 0
7025     while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
7026         if {$diffids eq $nullid} {
7027             set fname $line
7028         } else {
7029             set i [string first "\t" $line]
7030             if {$i < 0} continue
7031             set fname [string range $line [expr {$i+1}] end]
7032             set line [string range $line 0 [expr {$i-1}]]
7033             if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7034             set sha1 [lindex $line 2]
7035             lappend treeidlist($id) $sha1
7036         }
7037         if {[string index $fname 0] eq "\""} {
7038             set fname [lindex $fname 0]
7039         }
7040         set fname [encoding convertfrom $fname]
7041         lappend treefilelist($id) $fname
7042     }
7043     if {![eof $gtf]} {
7044         return [expr {$nl >= 1000? 2: 1}]
7045     }
7046     close $gtf
7047     unset treepending
7048     if {$cmitmode ne "tree"} {
7049         if {![info exists diffmergeid]} {
7050             gettreediffs $diffids
7051         }
7052     } elseif {$id ne $diffids} {
7053         gettree $diffids
7054     } else {
7055         setfilelist $id
7056     }
7057     return 0
7058 }
7059
7060 proc showfile {f} {
7061     global treefilelist treeidlist diffids nullid nullid2
7062     global ctext_file_names ctext_file_lines
7063     global ctext commentend
7064
7065     set i [lsearch -exact $treefilelist($diffids) $f]
7066     if {$i < 0} {
7067         puts "oops, $f not in list for id $diffids"
7068         return
7069     }
7070     if {$diffids eq $nullid} {
7071         if {[catch {set bf [open $f r]} err]} {
7072             puts "oops, can't read $f: $err"
7073             return
7074         }
7075     } else {
7076         set blob [lindex $treeidlist($diffids) $i]
7077         if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7078             puts "oops, error reading blob $blob: $err"
7079             return
7080         }
7081     }
7082     fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7083     filerun $bf [list getblobline $bf $diffids]
7084     $ctext config -state normal
7085     clear_ctext $commentend
7086     lappend ctext_file_names $f
7087     lappend ctext_file_lines [lindex [split $commentend "."] 0]
7088     $ctext insert end "\n"
7089     $ctext insert end "$f\n" filesep
7090     $ctext config -state disabled
7091     $ctext yview $commentend
7092     settabs 0
7093 }
7094
7095 proc getblobline {bf id} {
7096     global diffids cmitmode ctext
7097
7098     if {$id ne $diffids || $cmitmode ne "tree"} {
7099         catch {close $bf}
7100         return 0
7101     }
7102     $ctext config -state normal
7103     set nl 0
7104     while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7105         $ctext insert end "$line\n"
7106     }
7107     if {[eof $bf]} {
7108         global jump_to_here ctext_file_names commentend
7109
7110         # delete last newline
7111         $ctext delete "end - 2c" "end - 1c"
7112         close $bf
7113         if {$jump_to_here ne {} &&
7114             [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7115             set lnum [expr {[lindex $jump_to_here 1] +
7116                             [lindex [split $commentend .] 0]}]
7117             mark_ctext_line $lnum
7118         }
7119         return 0
7120     }
7121     $ctext config -state disabled
7122     return [expr {$nl >= 1000? 2: 1}]
7123 }
7124
7125 proc mark_ctext_line {lnum} {
7126     global ctext markbgcolor
7127
7128     $ctext tag delete omark
7129     $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7130     $ctext tag conf omark -background $markbgcolor
7131     $ctext see $lnum.0
7132 }
7133
7134 proc mergediff {id} {
7135     global diffmergeid
7136     global diffids treediffs
7137     global parents curview
7138
7139     set diffmergeid $id
7140     set diffids $id
7141     set treediffs($id) {}
7142     set np [llength $parents($curview,$id)]
7143     settabs $np
7144     getblobdiffs $id
7145 }
7146
7147 proc startdiff {ids} {
7148     global treediffs diffids treepending diffmergeid nullid nullid2
7149
7150     settabs 1
7151     set diffids $ids
7152     catch {unset diffmergeid}
7153     if {![info exists treediffs($ids)] ||
7154         [lsearch -exact $ids $nullid] >= 0 ||
7155         [lsearch -exact $ids $nullid2] >= 0} {
7156         if {![info exists treepending]} {
7157             gettreediffs $ids
7158         }
7159     } else {
7160         addtocflist $ids
7161     }
7162 }
7163
7164 proc path_filter {filter name} {
7165     foreach p $filter {
7166         set l [string length $p]
7167         if {[string index $p end] eq "/"} {
7168             if {[string compare -length $l $p $name] == 0} {
7169                 return 1
7170             }
7171         } else {
7172             if {[string compare -length $l $p $name] == 0 &&
7173                 ([string length $name] == $l ||
7174                  [string index $name $l] eq "/")} {
7175                 return 1
7176             }
7177         }
7178     }
7179     return 0
7180 }
7181
7182 proc addtocflist {ids} {
7183     global treediffs
7184
7185     add_flist $treediffs($ids)
7186     getblobdiffs $ids
7187 }
7188
7189 proc diffcmd {ids flags} {
7190     global nullid nullid2
7191
7192     set i [lsearch -exact $ids $nullid]
7193     set j [lsearch -exact $ids $nullid2]
7194     if {$i >= 0} {
7195         if {[llength $ids] > 1 && $j < 0} {
7196             # comparing working directory with some specific revision
7197             set cmd [concat | git diff-index $flags]
7198             if {$i == 0} {
7199                 lappend cmd -R [lindex $ids 1]
7200             } else {
7201                 lappend cmd [lindex $ids 0]
7202             }
7203         } else {
7204             # comparing working directory with index
7205             set cmd [concat | git diff-files $flags]
7206             if {$j == 1} {
7207                 lappend cmd -R
7208             }
7209         }
7210     } elseif {$j >= 0} {
7211         set cmd [concat | git diff-index --cached $flags]
7212         if {[llength $ids] > 1} {
7213             # comparing index with specific revision
7214             if {$i == 0} {
7215                 lappend cmd -R [lindex $ids 1]
7216             } else {
7217                 lappend cmd [lindex $ids 0]
7218             }
7219         } else {
7220             # comparing index with HEAD
7221             lappend cmd HEAD
7222         }
7223     } else {
7224         set cmd [concat | git diff-tree -r $flags $ids]
7225     }
7226     return $cmd
7227 }
7228
7229 proc gettreediffs {ids} {
7230     global treediff treepending
7231
7232     if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
7233
7234     set treepending $ids
7235     set treediff {}
7236     fconfigure $gdtf -blocking 0 -encoding binary
7237     filerun $gdtf [list gettreediffline $gdtf $ids]
7238 }
7239
7240 proc gettreediffline {gdtf ids} {
7241     global treediff treediffs treepending diffids diffmergeid
7242     global cmitmode vfilelimit curview limitdiffs perfile_attrs
7243
7244     set nr 0
7245     set sublist {}
7246     set max 1000
7247     if {$perfile_attrs} {
7248         # cache_gitattr is slow, and even slower on win32 where we
7249         # have to invoke it for only about 30 paths at a time
7250         set max 500
7251         if {[tk windowingsystem] == "win32"} {
7252             set max 120
7253         }
7254     }
7255     while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7256         set i [string first "\t" $line]
7257         if {$i >= 0} {
7258             set file [string range $line [expr {$i+1}] end]
7259             if {[string index $file 0] eq "\""} {
7260                 set file [lindex $file 0]
7261             }
7262             set file [encoding convertfrom $file]
7263             if {$file ne [lindex $treediff end]} {
7264                 lappend treediff $file
7265                 lappend sublist $file
7266             }
7267         }
7268     }
7269     if {$perfile_attrs} {
7270         cache_gitattr encoding $sublist
7271     }
7272     if {![eof $gdtf]} {
7273         return [expr {$nr >= $max? 2: 1}]
7274     }
7275     close $gdtf
7276     if {$limitdiffs && $vfilelimit($curview) ne {}} {
7277         set flist {}
7278         foreach f $treediff {
7279             if {[path_filter $vfilelimit($curview) $f]} {
7280                 lappend flist $f
7281             }
7282         }
7283         set treediffs($ids) $flist
7284     } else {
7285         set treediffs($ids) $treediff
7286     }
7287     unset treepending
7288     if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7289         gettree $diffids
7290     } elseif {$ids != $diffids} {
7291         if {![info exists diffmergeid]} {
7292             gettreediffs $diffids
7293         }
7294     } else {
7295         addtocflist $ids
7296     }
7297     return 0
7298 }
7299
7300 # empty string or positive integer
7301 proc diffcontextvalidate {v} {
7302     return [regexp {^(|[1-9][0-9]*)$} $v]
7303 }
7304
7305 proc diffcontextchange {n1 n2 op} {
7306     global diffcontextstring diffcontext
7307
7308     if {[string is integer -strict $diffcontextstring]} {
7309         if {$diffcontextstring > 0} {
7310             set diffcontext $diffcontextstring
7311             reselectline
7312         }
7313     }
7314 }
7315
7316 proc changeignorespace {} {
7317     reselectline
7318 }
7319
7320 proc getblobdiffs {ids} {
7321     global blobdifffd diffids env
7322     global diffinhdr treediffs
7323     global diffcontext
7324     global ignorespace
7325     global limitdiffs vfilelimit curview
7326     global diffencoding targetline diffnparents
7327     global git_version
7328
7329     set textconv {}
7330     if {[package vcompare $git_version "1.6.1"] >= 0} {
7331         set textconv "--textconv"
7332     }
7333     set cmd [diffcmd $ids "-p $textconv -C --cc --no-commit-id -U$diffcontext"]
7334     if {$ignorespace} {
7335         append cmd " -w"
7336     }
7337     if {$limitdiffs && $vfilelimit($curview) ne {}} {
7338         set cmd [concat $cmd -- $vfilelimit($curview)]
7339     }
7340     if {[catch {set bdf [open $cmd r]} err]} {
7341         error_popup [mc "Error getting diffs: %s" $err]
7342         return
7343     }
7344     set targetline {}
7345     set diffnparents 0
7346     set diffinhdr 0
7347     set diffencoding [get_path_encoding {}]
7348     fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
7349     set blobdifffd($ids) $bdf
7350     filerun $bdf [list getblobdiffline $bdf $diffids]
7351 }
7352
7353 proc setinlist {var i val} {
7354     global $var
7355
7356     while {[llength [set $var]] < $i} {
7357         lappend $var {}
7358     }
7359     if {[llength [set $var]] == $i} {
7360         lappend $var $val
7361     } else {
7362         lset $var $i $val
7363     }
7364 }
7365
7366 proc makediffhdr {fname ids} {
7367     global ctext curdiffstart treediffs diffencoding
7368     global ctext_file_names jump_to_here targetline diffline
7369
7370     set fname [encoding convertfrom $fname]
7371     set diffencoding [get_path_encoding $fname]
7372     set i [lsearch -exact $treediffs($ids) $fname]
7373     if {$i >= 0} {
7374         setinlist difffilestart $i $curdiffstart
7375     }
7376     lset ctext_file_names end $fname
7377     set l [expr {(78 - [string length $fname]) / 2}]
7378     set pad [string range "----------------------------------------" 1 $l]
7379     $ctext insert $curdiffstart "$pad $fname $pad" filesep
7380     set targetline {}
7381     if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
7382         set targetline [lindex $jump_to_here 1]
7383     }
7384     set diffline 0
7385 }
7386
7387 proc getblobdiffline {bdf ids} {
7388     global diffids blobdifffd ctext curdiffstart
7389     global diffnexthead diffnextnote difffilestart
7390     global ctext_file_names ctext_file_lines
7391     global diffinhdr treediffs mergemax diffnparents
7392     global diffencoding jump_to_here targetline diffline
7393
7394     set nr 0
7395     $ctext conf -state normal
7396     while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
7397         if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
7398             close $bdf
7399             return 0
7400         }
7401         if {![string compare -length 5 "diff " $line]} {
7402             if {![regexp {^diff (--cc|--git) } $line m type]} {
7403                 set line [encoding convertfrom $line]
7404                 $ctext insert end "$line\n" hunksep
7405                 continue
7406             }
7407             # start of a new file
7408             set diffinhdr 1
7409             $ctext insert end "\n"
7410             set curdiffstart [$ctext index "end - 1c"]
7411             lappend ctext_file_names ""
7412             lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7413             $ctext insert end "\n" filesep
7414
7415             if {$type eq "--cc"} {
7416                 # start of a new file in a merge diff
7417                 set fname [string range $line 10 end]
7418                 if {[lsearch -exact $treediffs($ids) $fname] < 0} {
7419                     lappend treediffs($ids) $fname
7420                     add_flist [list $fname]
7421                 }
7422
7423             } else {
7424                 set line [string range $line 11 end]
7425                 # If the name hasn't changed the length will be odd,
7426                 # the middle char will be a space, and the two bits either
7427                 # side will be a/name and b/name, or "a/name" and "b/name".
7428                 # If the name has changed we'll get "rename from" and
7429                 # "rename to" or "copy from" and "copy to" lines following
7430                 # this, and we'll use them to get the filenames.
7431                 # This complexity is necessary because spaces in the
7432                 # filename(s) don't get escaped.
7433                 set l [string length $line]
7434                 set i [expr {$l / 2}]
7435                 if {!(($l & 1) && [string index $line $i] eq " " &&
7436                       [string range $line 2 [expr {$i - 1}]] eq \
7437                           [string range $line [expr {$i + 3}] end])} {
7438                     continue
7439                 }
7440                 # unescape if quoted and chop off the a/ from the front
7441                 if {[string index $line 0] eq "\""} {
7442                     set fname [string range [lindex $line 0] 2 end]
7443                 } else {
7444                     set fname [string range $line 2 [expr {$i - 1}]]
7445                 }
7446             }
7447             makediffhdr $fname $ids
7448
7449         } elseif {![string compare -length 16 "* Unmerged path " $line]} {
7450             set fname [encoding convertfrom [string range $line 16 end]]
7451             $ctext insert end "\n"
7452             set curdiffstart [$ctext index "end - 1c"]
7453             lappend ctext_file_names $fname
7454             lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7455             $ctext insert end "$line\n" filesep
7456             set i [lsearch -exact $treediffs($ids) $fname]
7457             if {$i >= 0} {
7458                 setinlist difffilestart $i $curdiffstart
7459             }
7460
7461         } elseif {![string compare -length 2 "@@" $line]} {
7462             regexp {^@@+} $line ats
7463             set line [encoding convertfrom $diffencoding $line]
7464             $ctext insert end "$line\n" hunksep
7465             if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
7466                 set diffline $nl
7467             }
7468             set diffnparents [expr {[string length $ats] - 1}]
7469             set diffinhdr 0
7470
7471         } elseif {$diffinhdr} {
7472             if {![string compare -length 12 "rename from " $line]} {
7473                 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
7474                 if {[string index $fname 0] eq "\""} {
7475                     set fname [lindex $fname 0]
7476                 }
7477                 set fname [encoding convertfrom $fname]
7478                 set i [lsearch -exact $treediffs($ids) $fname]
7479                 if {$i >= 0} {
7480                     setinlist difffilestart $i $curdiffstart
7481                 }
7482             } elseif {![string compare -length 10 $line "rename to "] ||
7483                       ![string compare -length 8 $line "copy to "]} {
7484                 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
7485                 if {[string index $fname 0] eq "\""} {
7486                     set fname [lindex $fname 0]
7487                 }
7488                 makediffhdr $fname $ids
7489             } elseif {[string compare -length 3 $line "---"] == 0} {
7490                 # do nothing
7491                 continue
7492             } elseif {[string compare -length 3 $line "+++"] == 0} {
7493                 set diffinhdr 0
7494                 continue
7495             }
7496             $ctext insert end "$line\n" filesep
7497
7498         } else {
7499             set line [string map {\x1A ^Z} \
7500                           [encoding convertfrom $diffencoding $line]]
7501             # parse the prefix - one ' ', '-' or '+' for each parent
7502             set prefix [string range $line 0 [expr {$diffnparents - 1}]]
7503             set tag [expr {$diffnparents > 1? "m": "d"}]
7504             if {[string trim $prefix " -+"] eq {}} {
7505                 # prefix only has " ", "-" and "+" in it: normal diff line
7506                 set num [string first "-" $prefix]
7507                 if {$num >= 0} {
7508                     # removed line, first parent with line is $num
7509                     if {$num >= $mergemax} {
7510                         set num "max"
7511                     }
7512                     $ctext insert end "$line\n" $tag$num
7513                 } else {
7514                     set tags {}
7515                     if {[string first "+" $prefix] >= 0} {
7516                         # added line
7517                         lappend tags ${tag}result
7518                         if {$diffnparents > 1} {
7519                             set num [string first " " $prefix]
7520                             if {$num >= 0} {
7521                                 if {$num >= $mergemax} {
7522                                     set num "max"
7523                                 }
7524                                 lappend tags m$num
7525                             }
7526                         }
7527                     }
7528                     if {$targetline ne {}} {
7529                         if {$diffline == $targetline} {
7530                             set seehere [$ctext index "end - 1 chars"]
7531                             set targetline {}
7532                         } else {
7533                             incr diffline
7534                         }
7535                     }
7536                     $ctext insert end "$line\n" $tags
7537                 }
7538             } else {
7539                 # "\ No newline at end of file",
7540                 # or something else we don't recognize
7541                 $ctext insert end "$line\n" hunksep
7542             }
7543         }
7544     }
7545     if {[info exists seehere]} {
7546         mark_ctext_line [lindex [split $seehere .] 0]
7547     }
7548     $ctext conf -state disabled
7549     if {[eof $bdf]} {
7550         close $bdf
7551         return 0
7552     }
7553     return [expr {$nr >= 1000? 2: 1}]
7554 }
7555
7556 proc changediffdisp {} {
7557     global ctext diffelide
7558
7559     $ctext tag conf d0 -elide [lindex $diffelide 0]
7560     $ctext tag conf dresult -elide [lindex $diffelide 1]
7561 }
7562
7563 proc highlightfile {loc cline} {
7564     global ctext cflist cflist_top
7565
7566     $ctext yview $loc
7567     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
7568     $cflist tag add highlight $cline.0 "$cline.0 lineend"
7569     $cflist see $cline.0
7570     set cflist_top $cline
7571 }
7572
7573 proc prevfile {} {
7574     global difffilestart ctext cmitmode
7575
7576     if {$cmitmode eq "tree"} return
7577     set prev 0.0
7578     set prevline 1
7579     set here [$ctext index @0,0]
7580     foreach loc $difffilestart {
7581         if {[$ctext compare $loc >= $here]} {
7582             highlightfile $prev $prevline
7583             return
7584         }
7585         set prev $loc
7586         incr prevline
7587     }
7588     highlightfile $prev $prevline
7589 }
7590
7591 proc nextfile {} {
7592     global difffilestart ctext cmitmode
7593
7594     if {$cmitmode eq "tree"} return
7595     set here [$ctext index @0,0]
7596     set line 1
7597     foreach loc $difffilestart {
7598         incr line
7599         if {[$ctext compare $loc > $here]} {
7600             highlightfile $loc $line
7601             return
7602         }
7603     }
7604 }
7605
7606 proc clear_ctext {{first 1.0}} {
7607     global ctext smarktop smarkbot
7608     global ctext_file_names ctext_file_lines
7609     global pendinglinks
7610
7611     set l [lindex [split $first .] 0]
7612     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
7613         set smarktop $l
7614     }
7615     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
7616         set smarkbot $l
7617     }
7618     $ctext delete $first end
7619     if {$first eq "1.0"} {
7620         catch {unset pendinglinks}
7621     }
7622     set ctext_file_names {}
7623     set ctext_file_lines {}
7624 }
7625
7626 proc settabs {{firstab {}}} {
7627     global firsttabstop tabstop ctext have_tk85
7628
7629     if {$firstab ne {} && $have_tk85} {
7630         set firsttabstop $firstab
7631     }
7632     set w [font measure textfont "0"]
7633     if {$firsttabstop != 0} {
7634         $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
7635                                [expr {($firsttabstop + 2 * $tabstop) * $w}]]
7636     } elseif {$have_tk85 || $tabstop != 8} {
7637         $ctext conf -tabs [expr {$tabstop * $w}]
7638     } else {
7639         $ctext conf -tabs {}
7640     }
7641 }
7642
7643 proc incrsearch {name ix op} {
7644     global ctext searchstring searchdirn
7645
7646     $ctext tag remove found 1.0 end
7647     if {[catch {$ctext index anchor}]} {
7648         # no anchor set, use start of selection, or of visible area
7649         set sel [$ctext tag ranges sel]
7650         if {$sel ne {}} {
7651             $ctext mark set anchor [lindex $sel 0]
7652         } elseif {$searchdirn eq "-forwards"} {
7653             $ctext mark set anchor @0,0
7654         } else {
7655             $ctext mark set anchor @0,[winfo height $ctext]
7656         }
7657     }
7658     if {$searchstring ne {}} {
7659         set here [$ctext search $searchdirn -- $searchstring anchor]
7660         if {$here ne {}} {
7661             $ctext see $here
7662         }
7663         searchmarkvisible 1
7664     }
7665 }
7666
7667 proc dosearch {} {
7668     global sstring ctext searchstring searchdirn
7669
7670     focus $sstring
7671     $sstring icursor end
7672     set searchdirn -forwards
7673     if {$searchstring ne {}} {
7674         set sel [$ctext tag ranges sel]
7675         if {$sel ne {}} {
7676             set start "[lindex $sel 0] + 1c"
7677         } elseif {[catch {set start [$ctext index anchor]}]} {
7678             set start "@0,0"
7679         }
7680         set match [$ctext search -count mlen -- $searchstring $start]
7681         $ctext tag remove sel 1.0 end
7682         if {$match eq {}} {
7683             bell
7684             return
7685         }
7686         $ctext see $match
7687         set mend "$match + $mlen c"
7688         $ctext tag add sel $match $mend
7689         $ctext mark unset anchor
7690     }
7691 }
7692
7693 proc dosearchback {} {
7694     global sstring ctext searchstring searchdirn
7695
7696     focus $sstring
7697     $sstring icursor end
7698     set searchdirn -backwards
7699     if {$searchstring ne {}} {
7700         set sel [$ctext tag ranges sel]
7701         if {$sel ne {}} {
7702             set start [lindex $sel 0]
7703         } elseif {[catch {set start [$ctext index anchor]}]} {
7704             set start @0,[winfo height $ctext]
7705         }
7706         set match [$ctext search -backwards -count ml -- $searchstring $start]
7707         $ctext tag remove sel 1.0 end
7708         if {$match eq {}} {
7709             bell
7710             return
7711         }
7712         $ctext see $match
7713         set mend "$match + $ml c"
7714         $ctext tag add sel $match $mend
7715         $ctext mark unset anchor
7716     }
7717 }
7718
7719 proc searchmark {first last} {
7720     global ctext searchstring
7721
7722     set mend $first.0
7723     while {1} {
7724         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
7725         if {$match eq {}} break
7726         set mend "$match + $mlen c"
7727         $ctext tag add found $match $mend
7728     }
7729 }
7730
7731 proc searchmarkvisible {doall} {
7732     global ctext smarktop smarkbot
7733
7734     set topline [lindex [split [$ctext index @0,0] .] 0]
7735     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
7736     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
7737         # no overlap with previous
7738         searchmark $topline $botline
7739         set smarktop $topline
7740         set smarkbot $botline
7741     } else {
7742         if {$topline < $smarktop} {
7743             searchmark $topline [expr {$smarktop-1}]
7744             set smarktop $topline
7745         }
7746         if {$botline > $smarkbot} {
7747             searchmark [expr {$smarkbot+1}] $botline
7748             set smarkbot $botline
7749         }
7750     }
7751 }
7752
7753 proc scrolltext {f0 f1} {
7754     global searchstring
7755
7756     .bleft.bottom.sb set $f0 $f1
7757     if {$searchstring ne {}} {
7758         searchmarkvisible 0
7759     }
7760 }
7761
7762 proc setcoords {} {
7763     global linespc charspc canvx0 canvy0
7764     global xspc1 xspc2 lthickness
7765
7766     set linespc [font metrics mainfont -linespace]
7767     set charspc [font measure mainfont "m"]
7768     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
7769     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
7770     set lthickness [expr {int($linespc / 9) + 1}]
7771     set xspc1(0) $linespc
7772     set xspc2 $linespc
7773 }
7774
7775 proc redisplay {} {
7776     global canv
7777     global selectedline
7778
7779     set ymax [lindex [$canv cget -scrollregion] 3]
7780     if {$ymax eq {} || $ymax == 0} return
7781     set span [$canv yview]
7782     clear_display
7783     setcanvscroll
7784     allcanvs yview moveto [lindex $span 0]
7785     drawvisible
7786     if {$selectedline ne {}} {
7787         selectline $selectedline 0
7788         allcanvs yview moveto [lindex $span 0]
7789     }
7790 }
7791
7792 proc parsefont {f n} {
7793     global fontattr
7794
7795     set fontattr($f,family) [lindex $n 0]
7796     set s [lindex $n 1]
7797     if {$s eq {} || $s == 0} {
7798         set s 10
7799     } elseif {$s < 0} {
7800         set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
7801     }
7802     set fontattr($f,size) $s
7803     set fontattr($f,weight) normal
7804     set fontattr($f,slant) roman
7805     foreach style [lrange $n 2 end] {
7806         switch -- $style {
7807             "normal" -
7808             "bold"   {set fontattr($f,weight) $style}
7809             "roman" -
7810             "italic" {set fontattr($f,slant) $style}
7811         }
7812     }
7813 }
7814
7815 proc fontflags {f {isbold 0}} {
7816     global fontattr
7817
7818     return [list -family $fontattr($f,family) -size $fontattr($f,size) \
7819                 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
7820                 -slant $fontattr($f,slant)]
7821 }
7822
7823 proc fontname {f} {
7824     global fontattr
7825
7826     set n [list $fontattr($f,family) $fontattr($f,size)]
7827     if {$fontattr($f,weight) eq "bold"} {
7828         lappend n "bold"
7829     }
7830     if {$fontattr($f,slant) eq "italic"} {
7831         lappend n "italic"
7832     }
7833     return $n
7834 }
7835
7836 proc incrfont {inc} {
7837     global mainfont textfont ctext canv cflist showrefstop
7838     global stopped entries fontattr
7839
7840     unmarkmatches
7841     set s $fontattr(mainfont,size)
7842     incr s $inc
7843     if {$s < 1} {
7844         set s 1
7845     }
7846     set fontattr(mainfont,size) $s
7847     font config mainfont -size $s
7848     font config mainfontbold -size $s
7849     set mainfont [fontname mainfont]
7850     set s $fontattr(textfont,size)
7851     incr s $inc
7852     if {$s < 1} {
7853         set s 1
7854     }
7855     set fontattr(textfont,size) $s
7856     font config textfont -size $s
7857     font config textfontbold -size $s
7858     set textfont [fontname textfont]
7859     setcoords
7860     settabs
7861     redisplay
7862 }
7863
7864 proc clearsha1 {} {
7865     global sha1entry sha1string
7866     if {[string length $sha1string] == 40} {
7867         $sha1entry delete 0 end
7868     }
7869 }
7870
7871 proc sha1change {n1 n2 op} {
7872     global sha1string currentid sha1but
7873     if {$sha1string == {}
7874         || ([info exists currentid] && $sha1string == $currentid)} {
7875         set state disabled
7876     } else {
7877         set state normal
7878     }
7879     if {[$sha1but cget -state] == $state} return
7880     if {$state == "normal"} {
7881         $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
7882     } else {
7883         $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
7884     }
7885 }
7886
7887 proc gotocommit {} {
7888     global sha1string tagids headids curview varcid
7889
7890     if {$sha1string == {}
7891         || ([info exists currentid] && $sha1string == $currentid)} return
7892     if {[info exists tagids($sha1string)]} {
7893         set id $tagids($sha1string)
7894     } elseif {[info exists headids($sha1string)]} {
7895         set id $headids($sha1string)
7896     } else {
7897         set id [string tolower $sha1string]
7898         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
7899             set matches [longid $id]
7900             if {$matches ne {}} {
7901                 if {[llength $matches] > 1} {
7902                     error_popup [mc "Short SHA1 id %s is ambiguous" $id]
7903                     return
7904                 }
7905                 set id [lindex $matches 0]
7906             }
7907         }
7908     }
7909     if {[commitinview $id $curview]} {
7910         selectline [rowofcommit $id] 1
7911         return
7912     }
7913     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
7914         set msg [mc "SHA1 id %s is not known" $sha1string]
7915     } else {
7916         set msg [mc "Tag/Head %s is not known" $sha1string]
7917     }
7918     error_popup $msg
7919 }
7920
7921 proc lineenter {x y id} {
7922     global hoverx hovery hoverid hovertimer
7923     global commitinfo canv
7924
7925     if {![info exists commitinfo($id)] && ![getcommit $id]} return
7926     set hoverx $x
7927     set hovery $y
7928     set hoverid $id
7929     if {[info exists hovertimer]} {
7930         after cancel $hovertimer
7931     }
7932     set hovertimer [after 500 linehover]
7933     $canv delete hover
7934 }
7935
7936 proc linemotion {x y id} {
7937     global hoverx hovery hoverid hovertimer
7938
7939     if {[info exists hoverid] && $id == $hoverid} {
7940         set hoverx $x
7941         set hovery $y
7942         if {[info exists hovertimer]} {
7943             after cancel $hovertimer
7944         }
7945         set hovertimer [after 500 linehover]
7946     }
7947 }
7948
7949 proc lineleave {id} {
7950     global hoverid hovertimer canv
7951
7952     if {[info exists hoverid] && $id == $hoverid} {
7953         $canv delete hover
7954         if {[info exists hovertimer]} {
7955             after cancel $hovertimer
7956             unset hovertimer
7957         }
7958         unset hoverid
7959     }
7960 }
7961
7962 proc linehover {} {
7963     global hoverx hovery hoverid hovertimer
7964     global canv linespc lthickness
7965     global commitinfo
7966
7967     set text [lindex $commitinfo($hoverid) 0]
7968     set ymax [lindex [$canv cget -scrollregion] 3]
7969     if {$ymax == {}} return
7970     set yfrac [lindex [$canv yview] 0]
7971     set x [expr {$hoverx + 2 * $linespc}]
7972     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
7973     set x0 [expr {$x - 2 * $lthickness}]
7974     set y0 [expr {$y - 2 * $lthickness}]
7975     set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
7976     set y1 [expr {$y + $linespc + 2 * $lthickness}]
7977     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
7978                -fill \#ffff80 -outline black -width 1 -tags hover]
7979     $canv raise $t
7980     set t [$canv create text $x $y -anchor nw -text $text -tags hover \
7981                -font mainfont]
7982     $canv raise $t
7983 }
7984
7985 proc clickisonarrow {id y} {
7986     global lthickness
7987
7988     set ranges [rowranges $id]
7989     set thresh [expr {2 * $lthickness + 6}]
7990     set n [expr {[llength $ranges] - 1}]
7991     for {set i 1} {$i < $n} {incr i} {
7992         set row [lindex $ranges $i]
7993         if {abs([yc $row] - $y) < $thresh} {
7994             return $i
7995         }
7996     }
7997     return {}
7998 }
7999
8000 proc arrowjump {id n y} {
8001     global canv
8002
8003     # 1 <-> 2, 3 <-> 4, etc...
8004     set n [expr {(($n - 1) ^ 1) + 1}]
8005     set row [lindex [rowranges $id] $n]
8006     set yt [yc $row]
8007     set ymax [lindex [$canv cget -scrollregion] 3]
8008     if {$ymax eq {} || $ymax <= 0} return
8009     set view [$canv yview]
8010     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8011     set yfrac [expr {$yt / $ymax - $yspan / 2}]
8012     if {$yfrac < 0} {
8013         set yfrac 0
8014     }
8015     allcanvs yview moveto $yfrac
8016 }
8017
8018 proc lineclick {x y id isnew} {
8019     global ctext commitinfo children canv thickerline curview
8020
8021     if {![info exists commitinfo($id)] && ![getcommit $id]} return
8022     unmarkmatches
8023     unselectline
8024     normalline
8025     $canv delete hover
8026     # draw this line thicker than normal
8027     set thickerline $id
8028     drawlines $id
8029     if {$isnew} {
8030         set ymax [lindex [$canv cget -scrollregion] 3]
8031         if {$ymax eq {}} return
8032         set yfrac [lindex [$canv yview] 0]
8033         set y [expr {$y + $yfrac * $ymax}]
8034     }
8035     set dirn [clickisonarrow $id $y]
8036     if {$dirn ne {}} {
8037         arrowjump $id $dirn $y
8038         return
8039     }
8040
8041     if {$isnew} {
8042         addtohistory [list lineclick $x $y $id 0]
8043     }
8044     # fill the details pane with info about this line
8045     $ctext conf -state normal
8046     clear_ctext
8047     settabs 0
8048     $ctext insert end "[mc "Parent"]:\t"
8049     $ctext insert end $id link0
8050     setlink $id link0
8051     set info $commitinfo($id)
8052     $ctext insert end "\n\t[lindex $info 0]\n"
8053     $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8054     set date [formatdate [lindex $info 2]]
8055     $ctext insert end "\t[mc "Date"]:\t$date\n"
8056     set kids $children($curview,$id)
8057     if {$kids ne {}} {
8058         $ctext insert end "\n[mc "Children"]:"
8059         set i 0
8060         foreach child $kids {
8061             incr i
8062             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8063             set info $commitinfo($child)
8064             $ctext insert end "\n\t"
8065             $ctext insert end $child link$i
8066             setlink $child link$i
8067             $ctext insert end "\n\t[lindex $info 0]"
8068             $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8069             set date [formatdate [lindex $info 2]]
8070             $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8071         }
8072     }
8073     $ctext conf -state disabled
8074     init_flist {}
8075 }
8076
8077 proc normalline {} {
8078     global thickerline
8079     if {[info exists thickerline]} {
8080         set id $thickerline
8081         unset thickerline
8082         drawlines $id
8083     }
8084 }
8085
8086 proc selbyid {id} {
8087     global curview
8088     if {[commitinview $id $curview]} {
8089         selectline [rowofcommit $id] 1
8090     }
8091 }
8092
8093 proc mstime {} {
8094     global startmstime
8095     if {![info exists startmstime]} {
8096         set startmstime [clock clicks -milliseconds]
8097     }
8098     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8099 }
8100
8101 proc rowmenu {x y id} {
8102     global rowctxmenu selectedline rowmenuid curview
8103     global nullid nullid2 fakerowmenu mainhead markedid
8104
8105     stopfinding
8106     set rowmenuid $id
8107     if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8108         set state disabled
8109     } else {
8110         set state normal
8111     }
8112     if {$id ne $nullid && $id ne $nullid2} {
8113         set menu $rowctxmenu
8114         if {$mainhead ne {}} {
8115             $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead] -state normal
8116         } else {
8117             $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8118         }
8119         if {[info exists markedid] && $markedid ne $id} {
8120             $menu entryconfigure 9 -state normal
8121             $menu entryconfigure 10 -state normal
8122             $menu entryconfigure 11 -state normal
8123         } else {
8124             $menu entryconfigure 9 -state disabled
8125             $menu entryconfigure 10 -state disabled
8126             $menu entryconfigure 11 -state disabled
8127         }
8128     } else {
8129         set menu $fakerowmenu
8130     }
8131     $menu entryconfigure [mca "Diff this -> selected"] -state $state
8132     $menu entryconfigure [mca "Diff selected -> this"] -state $state
8133     $menu entryconfigure [mca "Make patch"] -state $state
8134     tk_popup $menu $x $y
8135 }
8136
8137 proc markhere {} {
8138     global rowmenuid markedid canv
8139
8140     set markedid $rowmenuid
8141     make_idmark $markedid
8142 }
8143
8144 proc gotomark {} {
8145     global markedid
8146
8147     if {[info exists markedid]} {
8148         selbyid $markedid
8149     }
8150 }
8151
8152 proc replace_by_kids {l r} {
8153     global curview children
8154
8155     set id [commitonrow $r]
8156     set l [lreplace $l 0 0]
8157     foreach kid $children($curview,$id) {
8158         lappend l [rowofcommit $kid]
8159     }
8160     return [lsort -integer -decreasing -unique $l]
8161 }
8162
8163 proc find_common_desc {} {
8164     global markedid rowmenuid curview children
8165
8166     if {![info exists markedid]} return
8167     if {![commitinview $markedid $curview] ||
8168         ![commitinview $rowmenuid $curview]} return
8169     #set t1 [clock clicks -milliseconds]
8170     set l1 [list [rowofcommit $markedid]]
8171     set l2 [list [rowofcommit $rowmenuid]]
8172     while 1 {
8173         set r1 [lindex $l1 0]
8174         set r2 [lindex $l2 0]
8175         if {$r1 eq {} || $r2 eq {}} break
8176         if {$r1 == $r2} {
8177             selectline $r1 1
8178             break
8179         }
8180         if {$r1 > $r2} {
8181             set l1 [replace_by_kids $l1 $r1]
8182         } else {
8183             set l2 [replace_by_kids $l2 $r2]
8184         }
8185     }
8186     #set t2 [clock clicks -milliseconds]
8187     #puts "took [expr {$t2-$t1}]ms"
8188 }
8189
8190 proc compare_commits {} {
8191     global markedid rowmenuid curview children
8192
8193     if {![info exists markedid]} return
8194     if {![commitinview $markedid $curview]} return
8195     addtohistory [list do_cmp_commits $markedid $rowmenuid]
8196     do_cmp_commits $markedid $rowmenuid
8197 }
8198
8199 proc getpatchid {id} {
8200     global patchids
8201
8202     if {![info exists patchids($id)]} {
8203         set cmd [diffcmd [list $id] {-p --root}]
8204         # trim off the initial "|"
8205         set cmd [lrange $cmd 1 end]
8206         if {[catch {
8207             set x [eval exec $cmd | git patch-id]
8208             set patchids($id) [lindex $x 0]
8209         }]} {
8210             set patchids($id) "error"
8211         }
8212     }
8213     return $patchids($id)
8214 }
8215
8216 proc do_cmp_commits {a b} {
8217     global ctext curview parents children patchids commitinfo
8218
8219     $ctext conf -state normal
8220     clear_ctext
8221     init_flist {}
8222     for {set i 0} {$i < 100} {incr i} {
8223         set skipa 0
8224         set skipb 0
8225         if {[llength $parents($curview,$a)] > 1} {
8226             appendshortlink $a [mc "Skipping merge commit "] "\n"
8227             set skipa 1
8228         } else {
8229             set patcha [getpatchid $a]
8230         }
8231         if {[llength $parents($curview,$b)] > 1} {
8232             appendshortlink $b [mc "Skipping merge commit "] "\n"
8233             set skipb 1
8234         } else {
8235             set patchb [getpatchid $b]
8236         }
8237         if {!$skipa && !$skipb} {
8238             set heada [lindex $commitinfo($a) 0]
8239             set headb [lindex $commitinfo($b) 0]
8240             if {$patcha eq "error"} {
8241                 appendshortlink $a [mc "Error getting patch ID for "] \
8242                     [mc " - stopping\n"]
8243                 break
8244             }
8245             if {$patchb eq "error"} {
8246                 appendshortlink $b [mc "Error getting patch ID for "] \
8247                     [mc " - stopping\n"]
8248                 break
8249             }
8250             if {$patcha eq $patchb} {
8251                 if {$heada eq $headb} {
8252                     appendshortlink $a [mc "Commit "]
8253                     appendshortlink $b " == " "  $heada\n"
8254                 } else {
8255                     appendshortlink $a [mc "Commit "] "  $heada\n"
8256                     appendshortlink $b [mc " is the same patch as\n       "] \
8257                         "  $headb\n"
8258                 }
8259                 set skipa 1
8260                 set skipb 1
8261             } else {
8262                 $ctext insert end "\n"
8263                 appendshortlink $a [mc "Commit "] "  $heada\n"
8264                 appendshortlink $b [mc " differs from\n       "] \
8265                     "  $headb\n"
8266                 $ctext insert end [mc "- stopping\n"]
8267                 break
8268             }
8269         }
8270         if {$skipa} {
8271             if {[llength $children($curview,$a)] != 1} {
8272                 $ctext insert end "\n"
8273                 appendshortlink $a [mc "Commit "] \
8274                     [mc " has %s children - stopping\n" \
8275                          [llength $children($curview,$a)]]
8276                 break
8277             }
8278             set a [lindex $children($curview,$a) 0]
8279         }
8280         if {$skipb} {
8281             if {[llength $children($curview,$b)] != 1} {
8282                 appendshortlink $b [mc "Commit "] \
8283                     [mc " has %s children - stopping\n" \
8284                          [llength $children($curview,$b)]]
8285                 break
8286             }
8287             set b [lindex $children($curview,$b) 0]
8288         }
8289     }
8290     $ctext conf -state disabled
8291 }
8292
8293 proc diffvssel {dirn} {
8294     global rowmenuid selectedline
8295
8296     if {$selectedline eq {}} return
8297     if {$dirn} {
8298         set oldid [commitonrow $selectedline]
8299         set newid $rowmenuid
8300     } else {
8301         set oldid $rowmenuid
8302         set newid [commitonrow $selectedline]
8303     }
8304     addtohistory [list doseldiff $oldid $newid]
8305     doseldiff $oldid $newid
8306 }
8307
8308 proc doseldiff {oldid newid} {
8309     global ctext
8310     global commitinfo
8311
8312     $ctext conf -state normal
8313     clear_ctext
8314     init_flist [mc "Top"]
8315     $ctext insert end "[mc "From"] "
8316     $ctext insert end $oldid link0
8317     setlink $oldid link0
8318     $ctext insert end "\n     "
8319     $ctext insert end [lindex $commitinfo($oldid) 0]
8320     $ctext insert end "\n\n[mc "To"]   "
8321     $ctext insert end $newid link1
8322     setlink $newid link1
8323     $ctext insert end "\n     "
8324     $ctext insert end [lindex $commitinfo($newid) 0]
8325     $ctext insert end "\n"
8326     $ctext conf -state disabled
8327     $ctext tag remove found 1.0 end
8328     startdiff [list $oldid $newid]
8329 }
8330
8331 proc mkpatch {} {
8332     global rowmenuid currentid commitinfo patchtop patchnum
8333
8334     if {![info exists currentid]} return
8335     set oldid $currentid
8336     set oldhead [lindex $commitinfo($oldid) 0]
8337     set newid $rowmenuid
8338     set newhead [lindex $commitinfo($newid) 0]
8339     set top .patch
8340     set patchtop $top
8341     catch {destroy $top}
8342     toplevel $top
8343     make_transient $top .
8344     label $top.title -text [mc "Generate patch"]
8345     grid $top.title - -pady 10
8346     label $top.from -text [mc "From:"]
8347     entry $top.fromsha1 -width 40 -relief flat
8348     $top.fromsha1 insert 0 $oldid
8349     $top.fromsha1 conf -state readonly
8350     grid $top.from $top.fromsha1 -sticky w
8351     entry $top.fromhead -width 60 -relief flat
8352     $top.fromhead insert 0 $oldhead
8353     $top.fromhead conf -state readonly
8354     grid x $top.fromhead -sticky w
8355     label $top.to -text [mc "To:"]
8356     entry $top.tosha1 -width 40 -relief flat
8357     $top.tosha1 insert 0 $newid
8358     $top.tosha1 conf -state readonly
8359     grid $top.to $top.tosha1 -sticky w
8360     entry $top.tohead -width 60 -relief flat
8361     $top.tohead insert 0 $newhead
8362     $top.tohead conf -state readonly
8363     grid x $top.tohead -sticky w
8364     button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
8365     grid $top.rev x -pady 10
8366     label $top.flab -text [mc "Output file:"]
8367     entry $top.fname -width 60
8368     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
8369     incr patchnum
8370     grid $top.flab $top.fname -sticky w
8371     frame $top.buts
8372     button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
8373     button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
8374     bind $top <Key-Return> mkpatchgo
8375     bind $top <Key-Escape> mkpatchcan
8376     grid $top.buts.gen $top.buts.can
8377     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8378     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8379     grid $top.buts - -pady 10 -sticky ew
8380     focus $top.fname
8381 }
8382
8383 proc mkpatchrev {} {
8384     global patchtop
8385
8386     set oldid [$patchtop.fromsha1 get]
8387     set oldhead [$patchtop.fromhead get]
8388     set newid [$patchtop.tosha1 get]
8389     set newhead [$patchtop.tohead get]
8390     foreach e [list fromsha1 fromhead tosha1 tohead] \
8391             v [list $newid $newhead $oldid $oldhead] {
8392         $patchtop.$e conf -state normal
8393         $patchtop.$e delete 0 end
8394         $patchtop.$e insert 0 $v
8395         $patchtop.$e conf -state readonly
8396     }
8397 }
8398
8399 proc mkpatchgo {} {
8400     global patchtop nullid nullid2
8401
8402     set oldid [$patchtop.fromsha1 get]
8403     set newid [$patchtop.tosha1 get]
8404     set fname [$patchtop.fname get]
8405     set cmd [diffcmd [list $oldid $newid] -p]
8406     # trim off the initial "|"
8407     set cmd [lrange $cmd 1 end]
8408     lappend cmd >$fname &
8409     if {[catch {eval exec $cmd} err]} {
8410         error_popup "[mc "Error creating patch:"] $err" $patchtop
8411     }
8412     catch {destroy $patchtop}
8413     unset patchtop
8414 }
8415
8416 proc mkpatchcan {} {
8417     global patchtop
8418
8419     catch {destroy $patchtop}
8420     unset patchtop
8421 }
8422
8423 proc mktag {} {
8424     global rowmenuid mktagtop commitinfo
8425
8426     set top .maketag
8427     set mktagtop $top
8428     catch {destroy $top}
8429     toplevel $top
8430     make_transient $top .
8431     label $top.title -text [mc "Create tag"]
8432     grid $top.title - -pady 10
8433     label $top.id -text [mc "ID:"]
8434     entry $top.sha1 -width 40 -relief flat
8435     $top.sha1 insert 0 $rowmenuid
8436     $top.sha1 conf -state readonly
8437     grid $top.id $top.sha1 -sticky w
8438     entry $top.head -width 60 -relief flat
8439     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8440     $top.head conf -state readonly
8441     grid x $top.head -sticky w
8442     label $top.tlab -text [mc "Tag name:"]
8443     entry $top.tag -width 60
8444     grid $top.tlab $top.tag -sticky w
8445     frame $top.buts
8446     button $top.buts.gen -text [mc "Create"] -command mktaggo
8447     button $top.buts.can -text [mc "Cancel"] -command mktagcan
8448     bind $top <Key-Return> mktaggo
8449     bind $top <Key-Escape> mktagcan
8450     grid $top.buts.gen $top.buts.can
8451     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8452     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8453     grid $top.buts - -pady 10 -sticky ew
8454     focus $top.tag
8455 }
8456
8457 proc domktag {} {
8458     global mktagtop env tagids idtags
8459
8460     set id [$mktagtop.sha1 get]
8461     set tag [$mktagtop.tag get]
8462     if {$tag == {}} {
8463         error_popup [mc "No tag name specified"] $mktagtop
8464         return 0
8465     }
8466     if {[info exists tagids($tag)]} {
8467         error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
8468         return 0
8469     }
8470     if {[catch {
8471         exec git tag $tag $id
8472     } err]} {
8473         error_popup "[mc "Error creating tag:"] $err" $mktagtop
8474         return 0
8475     }
8476
8477     set tagids($tag) $id
8478     lappend idtags($id) $tag
8479     redrawtags $id
8480     addedtag $id
8481     dispneartags 0
8482     run refill_reflist
8483     return 1
8484 }
8485
8486 proc redrawtags {id} {
8487     global canv linehtag idpos currentid curview cmitlisted markedid
8488     global canvxmax iddrawn circleitem mainheadid circlecolors
8489
8490     if {![commitinview $id $curview]} return
8491     if {![info exists iddrawn($id)]} return
8492     set row [rowofcommit $id]
8493     if {$id eq $mainheadid} {
8494         set ofill yellow
8495     } else {
8496         set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
8497     }
8498     $canv itemconf $circleitem($row) -fill $ofill
8499     $canv delete tag.$id
8500     set xt [eval drawtags $id $idpos($id)]
8501     $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
8502     set text [$canv itemcget $linehtag($id) -text]
8503     set font [$canv itemcget $linehtag($id) -font]
8504     set xr [expr {$xt + [font measure $font $text]}]
8505     if {$xr > $canvxmax} {
8506         set canvxmax $xr
8507         setcanvscroll
8508     }
8509     if {[info exists currentid] && $currentid == $id} {
8510         make_secsel $id
8511     }
8512     if {[info exists markedid] && $markedid eq $id} {
8513         make_idmark $id
8514     }
8515 }
8516
8517 proc mktagcan {} {
8518     global mktagtop
8519
8520     catch {destroy $mktagtop}
8521     unset mktagtop
8522 }
8523
8524 proc mktaggo {} {
8525     if {![domktag]} return
8526     mktagcan
8527 }
8528
8529 proc writecommit {} {
8530     global rowmenuid wrcomtop commitinfo wrcomcmd
8531
8532     set top .writecommit
8533     set wrcomtop $top
8534     catch {destroy $top}
8535     toplevel $top
8536     make_transient $top .
8537     label $top.title -text [mc "Write commit to file"]
8538     grid $top.title - -pady 10
8539     label $top.id -text [mc "ID:"]
8540     entry $top.sha1 -width 40 -relief flat
8541     $top.sha1 insert 0 $rowmenuid
8542     $top.sha1 conf -state readonly
8543     grid $top.id $top.sha1 -sticky w
8544     entry $top.head -width 60 -relief flat
8545     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8546     $top.head conf -state readonly
8547     grid x $top.head -sticky w
8548     label $top.clab -text [mc "Command:"]
8549     entry $top.cmd -width 60 -textvariable wrcomcmd
8550     grid $top.clab $top.cmd -sticky w -pady 10
8551     label $top.flab -text [mc "Output file:"]
8552     entry $top.fname -width 60
8553     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
8554     grid $top.flab $top.fname -sticky w
8555     frame $top.buts
8556     button $top.buts.gen -text [mc "Write"] -command wrcomgo
8557     button $top.buts.can -text [mc "Cancel"] -command wrcomcan
8558     bind $top <Key-Return> wrcomgo
8559     bind $top <Key-Escape> wrcomcan
8560     grid $top.buts.gen $top.buts.can
8561     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8562     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8563     grid $top.buts - -pady 10 -sticky ew
8564     focus $top.fname
8565 }
8566
8567 proc wrcomgo {} {
8568     global wrcomtop
8569
8570     set id [$wrcomtop.sha1 get]
8571     set cmd "echo $id | [$wrcomtop.cmd get]"
8572     set fname [$wrcomtop.fname get]
8573     if {[catch {exec sh -c $cmd >$fname &} err]} {
8574         error_popup "[mc "Error writing commit:"] $err" $wrcomtop
8575     }
8576     catch {destroy $wrcomtop}
8577     unset wrcomtop
8578 }
8579
8580 proc wrcomcan {} {
8581     global wrcomtop
8582
8583     catch {destroy $wrcomtop}
8584     unset wrcomtop
8585 }
8586
8587 proc mkbranch {} {
8588     global rowmenuid mkbrtop
8589
8590     set top .makebranch
8591     catch {destroy $top}
8592     toplevel $top
8593     make_transient $top .
8594     label $top.title -text [mc "Create new branch"]
8595     grid $top.title - -pady 10
8596     label $top.id -text [mc "ID:"]
8597     entry $top.sha1 -width 40 -relief flat
8598     $top.sha1 insert 0 $rowmenuid
8599     $top.sha1 conf -state readonly
8600     grid $top.id $top.sha1 -sticky w
8601     label $top.nlab -text [mc "Name:"]
8602     entry $top.name -width 40
8603     grid $top.nlab $top.name -sticky w
8604     frame $top.buts
8605     button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
8606     button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
8607     bind $top <Key-Return> [list mkbrgo $top]
8608     bind $top <Key-Escape> "catch {destroy $top}"
8609     grid $top.buts.go $top.buts.can
8610     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8611     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8612     grid $top.buts - -pady 10 -sticky ew
8613     focus $top.name
8614 }
8615
8616 proc mkbrgo {top} {
8617     global headids idheads
8618
8619     set name [$top.name get]
8620     set id [$top.sha1 get]
8621     set cmdargs {}
8622     set old_id {}
8623     if {$name eq {}} {
8624         error_popup [mc "Please specify a name for the new branch"] $top
8625         return
8626     }
8627     if {[info exists headids($name)]} {
8628         if {![confirm_popup [mc \
8629                 "Branch '%s' already exists. Overwrite?" $name] $top]} {
8630             return
8631         }
8632         set old_id $headids($name)
8633         lappend cmdargs -f
8634     }
8635     catch {destroy $top}
8636     lappend cmdargs $name $id
8637     nowbusy newbranch
8638     update
8639     if {[catch {
8640         eval exec git branch $cmdargs
8641     } err]} {
8642         notbusy newbranch
8643         error_popup $err
8644     } else {
8645         notbusy newbranch
8646         if {$old_id ne {}} {
8647             movehead $id $name
8648             movedhead $id $name
8649             redrawtags $old_id
8650             redrawtags $id
8651         } else {
8652             set headids($name) $id
8653             lappend idheads($id) $name
8654             addedhead $id $name
8655             redrawtags $id
8656         }
8657         dispneartags 0
8658         run refill_reflist
8659     }
8660 }
8661
8662 proc exec_citool {tool_args {baseid {}}} {
8663     global commitinfo env
8664
8665     set save_env [array get env GIT_AUTHOR_*]
8666
8667     if {$baseid ne {}} {
8668         if {![info exists commitinfo($baseid)]} {
8669             getcommit $baseid
8670         }
8671         set author [lindex $commitinfo($baseid) 1]
8672         set date [lindex $commitinfo($baseid) 2]
8673         if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
8674                     $author author name email]
8675             && $date ne {}} {
8676             set env(GIT_AUTHOR_NAME) $name
8677             set env(GIT_AUTHOR_EMAIL) $email
8678             set env(GIT_AUTHOR_DATE) $date
8679         }
8680     }
8681
8682     eval exec git citool $tool_args &
8683
8684     array unset env GIT_AUTHOR_*
8685     array set env $save_env
8686 }
8687
8688 proc cherrypick {} {
8689     global rowmenuid curview
8690     global mainhead mainheadid
8691
8692     set oldhead [exec git rev-parse HEAD]
8693     set dheads [descheads $rowmenuid]
8694     if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
8695         set ok [confirm_popup [mc "Commit %s is already\
8696                 included in branch %s -- really re-apply it?" \
8697                                    [string range $rowmenuid 0 7] $mainhead]]
8698         if {!$ok} return
8699     }
8700     nowbusy cherrypick [mc "Cherry-picking"]
8701     update
8702     # Unfortunately git-cherry-pick writes stuff to stderr even when
8703     # no error occurs, and exec takes that as an indication of error...
8704     if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
8705         notbusy cherrypick
8706         if {[regexp -line \
8707                  {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
8708                  $err msg fname]} {
8709             error_popup [mc "Cherry-pick failed because of local changes\
8710                         to file '%s'.\nPlease commit, reset or stash\
8711                         your changes and try again." $fname]
8712         } elseif {[regexp -line \
8713                        {^(CONFLICT \(.*\):|Automatic cherry-pick failed)} \
8714                        $err]} {
8715             if {[confirm_popup [mc "Cherry-pick failed because of merge\
8716                         conflict.\nDo you wish to run git citool to\
8717                         resolve it?"]]} {
8718                 # Force citool to read MERGE_MSG
8719                 file delete [file join [gitdir] "GITGUI_MSG"]
8720                 exec_citool {} $rowmenuid
8721             }
8722         } else {
8723             error_popup $err
8724         }
8725         run updatecommits
8726         return
8727     }
8728     set newhead [exec git rev-parse HEAD]
8729     if {$newhead eq $oldhead} {
8730         notbusy cherrypick
8731         error_popup [mc "No changes committed"]
8732         return
8733     }
8734     addnewchild $newhead $oldhead
8735     if {[commitinview $oldhead $curview]} {
8736         # XXX this isn't right if we have a path limit...
8737         insertrow $newhead $oldhead $curview
8738         if {$mainhead ne {}} {
8739             movehead $newhead $mainhead
8740             movedhead $newhead $mainhead
8741         }
8742         set mainheadid $newhead
8743         redrawtags $oldhead
8744         redrawtags $newhead
8745         selbyid $newhead
8746     }
8747     notbusy cherrypick
8748 }
8749
8750 proc resethead {} {
8751     global mainhead rowmenuid confirm_ok resettype
8752
8753     set confirm_ok 0
8754     set w ".confirmreset"
8755     toplevel $w
8756     make_transient $w .
8757     wm title $w [mc "Confirm reset"]
8758     message $w.m -text \
8759         [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
8760         -justify center -aspect 1000
8761     pack $w.m -side top -fill x -padx 20 -pady 20
8762     frame $w.f -relief sunken -border 2
8763     message $w.f.rt -text [mc "Reset type:"] -aspect 1000
8764     grid $w.f.rt -sticky w
8765     set resettype mixed
8766     radiobutton $w.f.soft -value soft -variable resettype -justify left \
8767         -text [mc "Soft: Leave working tree and index untouched"]
8768     grid $w.f.soft -sticky w
8769     radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
8770         -text [mc "Mixed: Leave working tree untouched, reset index"]
8771     grid $w.f.mixed -sticky w
8772     radiobutton $w.f.hard -value hard -variable resettype -justify left \
8773         -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
8774     grid $w.f.hard -sticky w
8775     pack $w.f -side top -fill x
8776     button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
8777     pack $w.ok -side left -fill x -padx 20 -pady 20
8778     button $w.cancel -text [mc Cancel] -command "destroy $w"
8779     bind $w <Key-Escape> [list destroy $w]
8780     pack $w.cancel -side right -fill x -padx 20 -pady 20
8781     bind $w <Visibility> "grab $w; focus $w"
8782     tkwait window $w
8783     if {!$confirm_ok} return
8784     if {[catch {set fd [open \
8785             [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
8786         error_popup $err
8787     } else {
8788         dohidelocalchanges
8789         filerun $fd [list readresetstat $fd]
8790         nowbusy reset [mc "Resetting"]
8791         selbyid $rowmenuid
8792     }
8793 }
8794
8795 proc readresetstat {fd} {
8796     global mainhead mainheadid showlocalchanges rprogcoord
8797
8798     if {[gets $fd line] >= 0} {
8799         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
8800             set rprogcoord [expr {1.0 * $m / $n}]
8801             adjustprogress
8802         }
8803         return 1
8804     }
8805     set rprogcoord 0
8806     adjustprogress
8807     notbusy reset
8808     if {[catch {close $fd} err]} {
8809         error_popup $err
8810     }
8811     set oldhead $mainheadid
8812     set newhead [exec git rev-parse HEAD]
8813     if {$newhead ne $oldhead} {
8814         movehead $newhead $mainhead
8815         movedhead $newhead $mainhead
8816         set mainheadid $newhead
8817         redrawtags $oldhead
8818         redrawtags $newhead
8819     }
8820     if {$showlocalchanges} {
8821         doshowlocalchanges
8822     }
8823     return 0
8824 }
8825
8826 # context menu for a head
8827 proc headmenu {x y id head} {
8828     global headmenuid headmenuhead headctxmenu mainhead
8829
8830     stopfinding
8831     set headmenuid $id
8832     set headmenuhead $head
8833     set state normal
8834     if {$head eq $mainhead} {
8835         set state disabled
8836     }
8837     $headctxmenu entryconfigure 0 -state $state
8838     $headctxmenu entryconfigure 1 -state $state
8839     tk_popup $headctxmenu $x $y
8840 }
8841
8842 proc cobranch {} {
8843     global headmenuid headmenuhead headids
8844     global showlocalchanges
8845
8846     # check the tree is clean first??
8847     nowbusy checkout [mc "Checking out"]
8848     update
8849     dohidelocalchanges
8850     if {[catch {
8851         set fd [open [list | git checkout $headmenuhead 2>@1] r]
8852     } err]} {
8853         notbusy checkout
8854         error_popup $err
8855         if {$showlocalchanges} {
8856             dodiffindex
8857         }
8858     } else {
8859         filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
8860     }
8861 }
8862
8863 proc readcheckoutstat {fd newhead newheadid} {
8864     global mainhead mainheadid headids showlocalchanges progresscoords
8865     global viewmainheadid curview
8866
8867     if {[gets $fd line] >= 0} {
8868         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
8869             set progresscoords [list 0 [expr {1.0 * $m / $n}]]
8870             adjustprogress
8871         }
8872         return 1
8873     }
8874     set progresscoords {0 0}
8875     adjustprogress
8876     notbusy checkout
8877     if {[catch {close $fd} err]} {
8878         error_popup $err
8879     }
8880     set oldmainid $mainheadid
8881     set mainhead $newhead
8882     set mainheadid $newheadid
8883     set viewmainheadid($curview) $newheadid
8884     redrawtags $oldmainid
8885     redrawtags $newheadid
8886     selbyid $newheadid
8887     if {$showlocalchanges} {
8888         dodiffindex
8889     }
8890 }
8891
8892 proc rmbranch {} {
8893     global headmenuid headmenuhead mainhead
8894     global idheads
8895
8896     set head $headmenuhead
8897     set id $headmenuid
8898     # this check shouldn't be needed any more...
8899     if {$head eq $mainhead} {
8900         error_popup [mc "Cannot delete the currently checked-out branch"]
8901         return
8902     }
8903     set dheads [descheads $id]
8904     if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
8905         # the stuff on this branch isn't on any other branch
8906         if {![confirm_popup [mc "The commits on branch %s aren't on any other\
8907                         branch.\nReally delete branch %s?" $head $head]]} return
8908     }
8909     nowbusy rmbranch
8910     update
8911     if {[catch {exec git branch -D $head} err]} {
8912         notbusy rmbranch
8913         error_popup $err
8914         return
8915     }
8916     removehead $id $head
8917     removedhead $id $head
8918     redrawtags $id
8919     notbusy rmbranch
8920     dispneartags 0
8921     run refill_reflist
8922 }
8923
8924 # Display a list of tags and heads
8925 proc showrefs {} {
8926     global showrefstop bgcolor fgcolor selectbgcolor
8927     global bglist fglist reflistfilter reflist maincursor
8928
8929     set top .showrefs
8930     set showrefstop $top
8931     if {[winfo exists $top]} {
8932         raise $top
8933         refill_reflist
8934         return
8935     }
8936     toplevel $top
8937     wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
8938     make_transient $top .
8939     text $top.list -background $bgcolor -foreground $fgcolor \
8940         -selectbackground $selectbgcolor -font mainfont \
8941         -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
8942         -width 30 -height 20 -cursor $maincursor \
8943         -spacing1 1 -spacing3 1 -state disabled
8944     $top.list tag configure highlight -background $selectbgcolor
8945     lappend bglist $top.list
8946     lappend fglist $top.list
8947     scrollbar $top.ysb -command "$top.list yview" -orient vertical
8948     scrollbar $top.xsb -command "$top.list xview" -orient horizontal
8949     grid $top.list $top.ysb -sticky nsew
8950     grid $top.xsb x -sticky ew
8951     frame $top.f
8952     label $top.f.l -text "[mc "Filter"]: "
8953     entry $top.f.e -width 20 -textvariable reflistfilter
8954     set reflistfilter "*"
8955     trace add variable reflistfilter write reflistfilter_change
8956     pack $top.f.e -side right -fill x -expand 1
8957     pack $top.f.l -side left
8958     grid $top.f - -sticky ew -pady 2
8959     button $top.close -command [list destroy $top] -text [mc "Close"]
8960     bind $top <Key-Escape> [list destroy $top]
8961     grid $top.close -
8962     grid columnconfigure $top 0 -weight 1
8963     grid rowconfigure $top 0 -weight 1
8964     bind $top.list <1> {break}
8965     bind $top.list <B1-Motion> {break}
8966     bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
8967     set reflist {}
8968     refill_reflist
8969 }
8970
8971 proc sel_reflist {w x y} {
8972     global showrefstop reflist headids tagids otherrefids
8973
8974     if {![winfo exists $showrefstop]} return
8975     set l [lindex [split [$w index "@$x,$y"] "."] 0]
8976     set ref [lindex $reflist [expr {$l-1}]]
8977     set n [lindex $ref 0]
8978     switch -- [lindex $ref 1] {
8979         "H" {selbyid $headids($n)}
8980         "T" {selbyid $tagids($n)}
8981         "o" {selbyid $otherrefids($n)}
8982     }
8983     $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
8984 }
8985
8986 proc unsel_reflist {} {
8987     global showrefstop
8988
8989     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
8990     $showrefstop.list tag remove highlight 0.0 end
8991 }
8992
8993 proc reflistfilter_change {n1 n2 op} {
8994     global reflistfilter
8995
8996     after cancel refill_reflist
8997     after 200 refill_reflist
8998 }
8999
9000 proc refill_reflist {} {
9001     global reflist reflistfilter showrefstop headids tagids otherrefids
9002     global curview
9003
9004     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9005     set refs {}
9006     foreach n [array names headids] {
9007         if {[string match $reflistfilter $n]} {
9008             if {[commitinview $headids($n) $curview]} {
9009                 lappend refs [list $n H]
9010             } else {
9011                 interestedin $headids($n) {run refill_reflist}
9012             }
9013         }
9014     }
9015     foreach n [array names tagids] {
9016         if {[string match $reflistfilter $n]} {
9017             if {[commitinview $tagids($n) $curview]} {
9018                 lappend refs [list $n T]
9019             } else {
9020                 interestedin $tagids($n) {run refill_reflist}
9021             }
9022         }
9023     }
9024     foreach n [array names otherrefids] {
9025         if {[string match $reflistfilter $n]} {
9026             if {[commitinview $otherrefids($n) $curview]} {
9027                 lappend refs [list $n o]
9028             } else {
9029                 interestedin $otherrefids($n) {run refill_reflist}
9030             }
9031         }
9032     }
9033     set refs [lsort -index 0 $refs]
9034     if {$refs eq $reflist} return
9035
9036     # Update the contents of $showrefstop.list according to the
9037     # differences between $reflist (old) and $refs (new)
9038     $showrefstop.list conf -state normal
9039     $showrefstop.list insert end "\n"
9040     set i 0
9041     set j 0
9042     while {$i < [llength $reflist] || $j < [llength $refs]} {
9043         if {$i < [llength $reflist]} {
9044             if {$j < [llength $refs]} {
9045                 set cmp [string compare [lindex $reflist $i 0] \
9046                              [lindex $refs $j 0]]
9047                 if {$cmp == 0} {
9048                     set cmp [string compare [lindex $reflist $i 1] \
9049                                  [lindex $refs $j 1]]
9050                 }
9051             } else {
9052                 set cmp -1
9053             }
9054         } else {
9055             set cmp 1
9056         }
9057         switch -- $cmp {
9058             -1 {
9059                 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
9060                 incr i
9061             }
9062             0 {
9063                 incr i
9064                 incr j
9065             }
9066             1 {
9067                 set l [expr {$j + 1}]
9068                 $showrefstop.list image create $l.0 -align baseline \
9069                     -image reficon-[lindex $refs $j 1] -padx 2
9070                 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
9071                 incr j
9072             }
9073         }
9074     }
9075     set reflist $refs
9076     # delete last newline
9077     $showrefstop.list delete end-2c end-1c
9078     $showrefstop.list conf -state disabled
9079 }
9080
9081 # Stuff for finding nearby tags
9082 proc getallcommits {} {
9083     global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
9084     global idheads idtags idotherrefs allparents tagobjid
9085
9086     if {![info exists allcommits]} {
9087         set nextarc 0
9088         set allcommits 0
9089         set seeds {}
9090         set allcwait 0
9091         set cachedarcs 0
9092         set allccache [file join [gitdir] "gitk.cache"]
9093         if {![catch {
9094             set f [open $allccache r]
9095             set allcwait 1
9096             getcache $f
9097         }]} return
9098     }
9099
9100     if {$allcwait} {
9101         return
9102     }
9103     set cmd [list | git rev-list --parents]
9104     set allcupdate [expr {$seeds ne {}}]
9105     if {!$allcupdate} {
9106         set ids "--all"
9107     } else {
9108         set refs [concat [array names idheads] [array names idtags] \
9109                       [array names idotherrefs]]
9110         set ids {}
9111         set tagobjs {}
9112         foreach name [array names tagobjid] {
9113             lappend tagobjs $tagobjid($name)
9114         }
9115         foreach id [lsort -unique $refs] {
9116             if {![info exists allparents($id)] &&
9117                 [lsearch -exact $tagobjs $id] < 0} {
9118                 lappend ids $id
9119             }
9120         }
9121         if {$ids ne {}} {
9122             foreach id $seeds {
9123                 lappend ids "^$id"
9124             }
9125         }
9126     }
9127     if {$ids ne {}} {
9128         set fd [open [concat $cmd $ids] r]
9129         fconfigure $fd -blocking 0
9130         incr allcommits
9131         nowbusy allcommits
9132         filerun $fd [list getallclines $fd]
9133     } else {
9134         dispneartags 0
9135     }
9136 }
9137
9138 # Since most commits have 1 parent and 1 child, we group strings of
9139 # such commits into "arcs" joining branch/merge points (BMPs), which
9140 # are commits that either don't have 1 parent or don't have 1 child.
9141 #
9142 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
9143 # arcout(id) - outgoing arcs for BMP
9144 # arcids(a) - list of IDs on arc including end but not start
9145 # arcstart(a) - BMP ID at start of arc
9146 # arcend(a) - BMP ID at end of arc
9147 # growing(a) - arc a is still growing
9148 # arctags(a) - IDs out of arcids (excluding end) that have tags
9149 # archeads(a) - IDs out of arcids (excluding end) that have heads
9150 # The start of an arc is at the descendent end, so "incoming" means
9151 # coming from descendents, and "outgoing" means going towards ancestors.
9152
9153 proc getallclines {fd} {
9154     global allparents allchildren idtags idheads nextarc
9155     global arcnos arcids arctags arcout arcend arcstart archeads growing
9156     global seeds allcommits cachedarcs allcupdate
9157
9158     set nid 0
9159     while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
9160         set id [lindex $line 0]
9161         if {[info exists allparents($id)]} {
9162             # seen it already
9163             continue
9164         }
9165         set cachedarcs 0
9166         set olds [lrange $line 1 end]
9167         set allparents($id) $olds
9168         if {![info exists allchildren($id)]} {
9169             set allchildren($id) {}
9170             set arcnos($id) {}
9171             lappend seeds $id
9172         } else {
9173             set a $arcnos($id)
9174             if {[llength $olds] == 1 && [llength $a] == 1} {
9175                 lappend arcids($a) $id
9176                 if {[info exists idtags($id)]} {
9177                     lappend arctags($a) $id
9178                 }
9179                 if {[info exists idheads($id)]} {
9180                     lappend archeads($a) $id
9181                 }
9182                 if {[info exists allparents($olds)]} {
9183                     # seen parent already
9184                     if {![info exists arcout($olds)]} {
9185                         splitarc $olds
9186                     }
9187                     lappend arcids($a) $olds
9188                     set arcend($a) $olds
9189                     unset growing($a)
9190                 }
9191                 lappend allchildren($olds) $id
9192                 lappend arcnos($olds) $a
9193                 continue
9194             }
9195         }
9196         foreach a $arcnos($id) {
9197             lappend arcids($a) $id
9198             set arcend($a) $id
9199             unset growing($a)
9200         }
9201
9202         set ao {}
9203         foreach p $olds {
9204             lappend allchildren($p) $id
9205             set a [incr nextarc]
9206             set arcstart($a) $id
9207             set archeads($a) {}
9208             set arctags($a) {}
9209             set archeads($a) {}
9210             set arcids($a) {}
9211             lappend ao $a
9212             set growing($a) 1
9213             if {[info exists allparents($p)]} {
9214                 # seen it already, may need to make a new branch
9215                 if {![info exists arcout($p)]} {
9216                     splitarc $p
9217                 }
9218                 lappend arcids($a) $p
9219                 set arcend($a) $p
9220                 unset growing($a)
9221             }
9222             lappend arcnos($p) $a
9223         }
9224         set arcout($id) $ao
9225     }
9226     if {$nid > 0} {
9227         global cached_dheads cached_dtags cached_atags
9228         catch {unset cached_dheads}
9229         catch {unset cached_dtags}
9230         catch {unset cached_atags}
9231     }
9232     if {![eof $fd]} {
9233         return [expr {$nid >= 1000? 2: 1}]
9234     }
9235     set cacheok 1
9236     if {[catch {
9237         fconfigure $fd -blocking 1
9238         close $fd
9239     } err]} {
9240         # got an error reading the list of commits
9241         # if we were updating, try rereading the whole thing again
9242         if {$allcupdate} {
9243             incr allcommits -1
9244             dropcache $err
9245             return
9246         }
9247         error_popup "[mc "Error reading commit topology information;\
9248                 branch and preceding/following tag information\
9249                 will be incomplete."]\n($err)"
9250         set cacheok 0
9251     }
9252     if {[incr allcommits -1] == 0} {
9253         notbusy allcommits
9254         if {$cacheok} {
9255             run savecache
9256         }
9257     }
9258     dispneartags 0
9259     return 0
9260 }
9261
9262 proc recalcarc {a} {
9263     global arctags archeads arcids idtags idheads
9264
9265     set at {}
9266     set ah {}
9267     foreach id [lrange $arcids($a) 0 end-1] {
9268         if {[info exists idtags($id)]} {
9269             lappend at $id
9270         }
9271         if {[info exists idheads($id)]} {
9272             lappend ah $id
9273         }
9274     }
9275     set arctags($a) $at
9276     set archeads($a) $ah
9277 }
9278
9279 proc splitarc {p} {
9280     global arcnos arcids nextarc arctags archeads idtags idheads
9281     global arcstart arcend arcout allparents growing
9282
9283     set a $arcnos($p)
9284     if {[llength $a] != 1} {
9285         puts "oops splitarc called but [llength $a] arcs already"
9286         return
9287     }
9288     set a [lindex $a 0]
9289     set i [lsearch -exact $arcids($a) $p]
9290     if {$i < 0} {
9291         puts "oops splitarc $p not in arc $a"
9292         return
9293     }
9294     set na [incr nextarc]
9295     if {[info exists arcend($a)]} {
9296         set arcend($na) $arcend($a)
9297     } else {
9298         set l [lindex $allparents([lindex $arcids($a) end]) 0]
9299         set j [lsearch -exact $arcnos($l) $a]
9300         set arcnos($l) [lreplace $arcnos($l) $j $j $na]
9301     }
9302     set tail [lrange $arcids($a) [expr {$i+1}] end]
9303     set arcids($a) [lrange $arcids($a) 0 $i]
9304     set arcend($a) $p
9305     set arcstart($na) $p
9306     set arcout($p) $na
9307     set arcids($na) $tail
9308     if {[info exists growing($a)]} {
9309         set growing($na) 1
9310         unset growing($a)
9311     }
9312
9313     foreach id $tail {
9314         if {[llength $arcnos($id)] == 1} {
9315             set arcnos($id) $na
9316         } else {
9317             set j [lsearch -exact $arcnos($id) $a]
9318             set arcnos($id) [lreplace $arcnos($id) $j $j $na]
9319         }
9320     }
9321
9322     # reconstruct tags and heads lists
9323     if {$arctags($a) ne {} || $archeads($a) ne {}} {
9324         recalcarc $a
9325         recalcarc $na
9326     } else {
9327         set arctags($na) {}
9328         set archeads($na) {}
9329     }
9330 }
9331
9332 # Update things for a new commit added that is a child of one
9333 # existing commit.  Used when cherry-picking.
9334 proc addnewchild {id p} {
9335     global allparents allchildren idtags nextarc
9336     global arcnos arcids arctags arcout arcend arcstart archeads growing
9337     global seeds allcommits
9338
9339     if {![info exists allcommits] || ![info exists arcnos($p)]} return
9340     set allparents($id) [list $p]
9341     set allchildren($id) {}
9342     set arcnos($id) {}
9343     lappend seeds $id
9344     lappend allchildren($p) $id
9345     set a [incr nextarc]
9346     set arcstart($a) $id
9347     set archeads($a) {}
9348     set arctags($a) {}
9349     set arcids($a) [list $p]
9350     set arcend($a) $p
9351     if {![info exists arcout($p)]} {
9352         splitarc $p
9353     }
9354     lappend arcnos($p) $a
9355     set arcout($id) [list $a]
9356 }
9357
9358 # This implements a cache for the topology information.
9359 # The cache saves, for each arc, the start and end of the arc,
9360 # the ids on the arc, and the outgoing arcs from the end.
9361 proc readcache {f} {
9362     global arcnos arcids arcout arcstart arcend arctags archeads nextarc
9363     global idtags idheads allparents cachedarcs possible_seeds seeds growing
9364     global allcwait
9365
9366     set a $nextarc
9367     set lim $cachedarcs
9368     if {$lim - $a > 500} {
9369         set lim [expr {$a + 500}]
9370     }
9371     if {[catch {
9372         if {$a == $lim} {
9373             # finish reading the cache and setting up arctags, etc.
9374             set line [gets $f]
9375             if {$line ne "1"} {error "bad final version"}
9376             close $f
9377             foreach id [array names idtags] {
9378                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9379                     [llength $allparents($id)] == 1} {
9380                     set a [lindex $arcnos($id) 0]
9381                     if {$arctags($a) eq {}} {
9382                         recalcarc $a
9383                     }
9384                 }
9385             }
9386             foreach id [array names idheads] {
9387                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9388                     [llength $allparents($id)] == 1} {
9389                     set a [lindex $arcnos($id) 0]
9390                     if {$archeads($a) eq {}} {
9391                         recalcarc $a
9392                     }
9393                 }
9394             }
9395             foreach id [lsort -unique $possible_seeds] {
9396                 if {$arcnos($id) eq {}} {
9397                     lappend seeds $id
9398                 }
9399             }
9400             set allcwait 0
9401         } else {
9402             while {[incr a] <= $lim} {
9403                 set line [gets $f]
9404                 if {[llength $line] != 3} {error "bad line"}
9405                 set s [lindex $line 0]
9406                 set arcstart($a) $s
9407                 lappend arcout($s) $a
9408                 if {![info exists arcnos($s)]} {
9409                     lappend possible_seeds $s
9410                     set arcnos($s) {}
9411                 }
9412                 set e [lindex $line 1]
9413                 if {$e eq {}} {
9414                     set growing($a) 1
9415                 } else {
9416                     set arcend($a) $e
9417                     if {![info exists arcout($e)]} {
9418                         set arcout($e) {}
9419                     }
9420                 }
9421                 set arcids($a) [lindex $line 2]
9422                 foreach id $arcids($a) {
9423                     lappend allparents($s) $id
9424                     set s $id
9425                     lappend arcnos($id) $a
9426                 }
9427                 if {![info exists allparents($s)]} {
9428                     set allparents($s) {}
9429                 }
9430                 set arctags($a) {}
9431                 set archeads($a) {}
9432             }
9433             set nextarc [expr {$a - 1}]
9434         }
9435     } err]} {
9436         dropcache $err
9437         return 0
9438     }
9439     if {!$allcwait} {
9440         getallcommits
9441     }
9442     return $allcwait
9443 }
9444
9445 proc getcache {f} {
9446     global nextarc cachedarcs possible_seeds
9447
9448     if {[catch {
9449         set line [gets $f]
9450         if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
9451         # make sure it's an integer
9452         set cachedarcs [expr {int([lindex $line 1])}]
9453         if {$cachedarcs < 0} {error "bad number of arcs"}
9454         set nextarc 0
9455         set possible_seeds {}
9456         run readcache $f
9457     } err]} {
9458         dropcache $err
9459     }
9460     return 0
9461 }
9462
9463 proc dropcache {err} {
9464     global allcwait nextarc cachedarcs seeds
9465
9466     #puts "dropping cache ($err)"
9467     foreach v {arcnos arcout arcids arcstart arcend growing \
9468                    arctags archeads allparents allchildren} {
9469         global $v
9470         catch {unset $v}
9471     }
9472     set allcwait 0
9473     set nextarc 0
9474     set cachedarcs 0
9475     set seeds {}
9476     getallcommits
9477 }
9478
9479 proc writecache {f} {
9480     global cachearc cachedarcs allccache
9481     global arcstart arcend arcnos arcids arcout
9482
9483     set a $cachearc
9484     set lim $cachedarcs
9485     if {$lim - $a > 1000} {
9486         set lim [expr {$a + 1000}]
9487     }
9488     if {[catch {
9489         while {[incr a] <= $lim} {
9490             if {[info exists arcend($a)]} {
9491                 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
9492             } else {
9493                 puts $f [list $arcstart($a) {} $arcids($a)]
9494             }
9495         }
9496     } err]} {
9497         catch {close $f}
9498         catch {file delete $allccache}
9499         #puts "writing cache failed ($err)"
9500         return 0
9501     }
9502     set cachearc [expr {$a - 1}]
9503     if {$a > $cachedarcs} {
9504         puts $f "1"
9505         close $f
9506         return 0
9507     }
9508     return 1
9509 }
9510
9511 proc savecache {} {
9512     global nextarc cachedarcs cachearc allccache
9513
9514     if {$nextarc == $cachedarcs} return
9515     set cachearc 0
9516     set cachedarcs $nextarc
9517     catch {
9518         set f [open $allccache w]
9519         puts $f [list 1 $cachedarcs]
9520         run writecache $f
9521     }
9522 }
9523
9524 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
9525 # or 0 if neither is true.
9526 proc anc_or_desc {a b} {
9527     global arcout arcstart arcend arcnos cached_isanc
9528
9529     if {$arcnos($a) eq $arcnos($b)} {
9530         # Both are on the same arc(s); either both are the same BMP,
9531         # or if one is not a BMP, the other is also not a BMP or is
9532         # the BMP at end of the arc (and it only has 1 incoming arc).
9533         # Or both can be BMPs with no incoming arcs.
9534         if {$a eq $b || $arcnos($a) eq {}} {
9535             return 0
9536         }
9537         # assert {[llength $arcnos($a)] == 1}
9538         set arc [lindex $arcnos($a) 0]
9539         set i [lsearch -exact $arcids($arc) $a]
9540         set j [lsearch -exact $arcids($arc) $b]
9541         if {$i < 0 || $i > $j} {
9542             return 1
9543         } else {
9544             return -1
9545         }
9546     }
9547
9548     if {![info exists arcout($a)]} {
9549         set arc [lindex $arcnos($a) 0]
9550         if {[info exists arcend($arc)]} {
9551             set aend $arcend($arc)
9552         } else {
9553             set aend {}
9554         }
9555         set a $arcstart($arc)
9556     } else {
9557         set aend $a
9558     }
9559     if {![info exists arcout($b)]} {
9560         set arc [lindex $arcnos($b) 0]
9561         if {[info exists arcend($arc)]} {
9562             set bend $arcend($arc)
9563         } else {
9564             set bend {}
9565         }
9566         set b $arcstart($arc)
9567     } else {
9568         set bend $b
9569     }
9570     if {$a eq $bend} {
9571         return 1
9572     }
9573     if {$b eq $aend} {
9574         return -1
9575     }
9576     if {[info exists cached_isanc($a,$bend)]} {
9577         if {$cached_isanc($a,$bend)} {
9578             return 1
9579         }
9580     }
9581     if {[info exists cached_isanc($b,$aend)]} {
9582         if {$cached_isanc($b,$aend)} {
9583             return -1
9584         }
9585         if {[info exists cached_isanc($a,$bend)]} {
9586             return 0
9587         }
9588     }
9589
9590     set todo [list $a $b]
9591     set anc($a) a
9592     set anc($b) b
9593     for {set i 0} {$i < [llength $todo]} {incr i} {
9594         set x [lindex $todo $i]
9595         if {$anc($x) eq {}} {
9596             continue
9597         }
9598         foreach arc $arcnos($x) {
9599             set xd $arcstart($arc)
9600             if {$xd eq $bend} {
9601                 set cached_isanc($a,$bend) 1
9602                 set cached_isanc($b,$aend) 0
9603                 return 1
9604             } elseif {$xd eq $aend} {
9605                 set cached_isanc($b,$aend) 1
9606                 set cached_isanc($a,$bend) 0
9607                 return -1
9608             }
9609             if {![info exists anc($xd)]} {
9610                 set anc($xd) $anc($x)
9611                 lappend todo $xd
9612             } elseif {$anc($xd) ne $anc($x)} {
9613                 set anc($xd) {}
9614             }
9615         }
9616     }
9617     set cached_isanc($a,$bend) 0
9618     set cached_isanc($b,$aend) 0
9619     return 0
9620 }
9621
9622 # This identifies whether $desc has an ancestor that is
9623 # a growing tip of the graph and which is not an ancestor of $anc
9624 # and returns 0 if so and 1 if not.
9625 # If we subsequently discover a tag on such a growing tip, and that
9626 # turns out to be a descendent of $anc (which it could, since we
9627 # don't necessarily see children before parents), then $desc
9628 # isn't a good choice to display as a descendent tag of
9629 # $anc (since it is the descendent of another tag which is
9630 # a descendent of $anc).  Similarly, $anc isn't a good choice to
9631 # display as a ancestor tag of $desc.
9632 #
9633 proc is_certain {desc anc} {
9634     global arcnos arcout arcstart arcend growing problems
9635
9636     set certain {}
9637     if {[llength $arcnos($anc)] == 1} {
9638         # tags on the same arc are certain
9639         if {$arcnos($desc) eq $arcnos($anc)} {
9640             return 1
9641         }
9642         if {![info exists arcout($anc)]} {
9643             # if $anc is partway along an arc, use the start of the arc instead
9644             set a [lindex $arcnos($anc) 0]
9645             set anc $arcstart($a)
9646         }
9647     }
9648     if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
9649         set x $desc
9650     } else {
9651         set a [lindex $arcnos($desc) 0]
9652         set x $arcend($a)
9653     }
9654     if {$x == $anc} {
9655         return 1
9656     }
9657     set anclist [list $x]
9658     set dl($x) 1
9659     set nnh 1
9660     set ngrowanc 0
9661     for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
9662         set x [lindex $anclist $i]
9663         if {$dl($x)} {
9664             incr nnh -1
9665         }
9666         set done($x) 1
9667         foreach a $arcout($x) {
9668             if {[info exists growing($a)]} {
9669                 if {![info exists growanc($x)] && $dl($x)} {
9670                     set growanc($x) 1
9671                     incr ngrowanc
9672                 }
9673             } else {
9674                 set y $arcend($a)
9675                 if {[info exists dl($y)]} {
9676                     if {$dl($y)} {
9677                         if {!$dl($x)} {
9678                             set dl($y) 0
9679                             if {![info exists done($y)]} {
9680                                 incr nnh -1
9681                             }
9682                             if {[info exists growanc($x)]} {
9683                                 incr ngrowanc -1
9684                             }
9685                             set xl [list $y]
9686                             for {set k 0} {$k < [llength $xl]} {incr k} {
9687                                 set z [lindex $xl $k]
9688                                 foreach c $arcout($z) {
9689                                     if {[info exists arcend($c)]} {
9690                                         set v $arcend($c)
9691                                         if {[info exists dl($v)] && $dl($v)} {
9692                                             set dl($v) 0
9693                                             if {![info exists done($v)]} {
9694                                                 incr nnh -1
9695                                             }
9696                                             if {[info exists growanc($v)]} {
9697                                                 incr ngrowanc -1
9698                                             }
9699                                             lappend xl $v
9700                                         }
9701                                     }
9702                                 }
9703                             }
9704                         }
9705                     }
9706                 } elseif {$y eq $anc || !$dl($x)} {
9707                     set dl($y) 0
9708                     lappend anclist $y
9709                 } else {
9710                     set dl($y) 1
9711                     lappend anclist $y
9712                     incr nnh
9713                 }
9714             }
9715         }
9716     }
9717     foreach x [array names growanc] {
9718         if {$dl($x)} {
9719             return 0
9720         }
9721         return 0
9722     }
9723     return 1
9724 }
9725
9726 proc validate_arctags {a} {
9727     global arctags idtags
9728
9729     set i -1
9730     set na $arctags($a)
9731     foreach id $arctags($a) {
9732         incr i
9733         if {![info exists idtags($id)]} {
9734             set na [lreplace $na $i $i]
9735             incr i -1
9736         }
9737     }
9738     set arctags($a) $na
9739 }
9740
9741 proc validate_archeads {a} {
9742     global archeads idheads
9743
9744     set i -1
9745     set na $archeads($a)
9746     foreach id $archeads($a) {
9747         incr i
9748         if {![info exists idheads($id)]} {
9749             set na [lreplace $na $i $i]
9750             incr i -1
9751         }
9752     }
9753     set archeads($a) $na
9754 }
9755
9756 # Return the list of IDs that have tags that are descendents of id,
9757 # ignoring IDs that are descendents of IDs already reported.
9758 proc desctags {id} {
9759     global arcnos arcstart arcids arctags idtags allparents
9760     global growing cached_dtags
9761
9762     if {![info exists allparents($id)]} {
9763         return {}
9764     }
9765     set t1 [clock clicks -milliseconds]
9766     set argid $id
9767     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9768         # part-way along an arc; check that arc first
9769         set a [lindex $arcnos($id) 0]
9770         if {$arctags($a) ne {}} {
9771             validate_arctags $a
9772             set i [lsearch -exact $arcids($a) $id]
9773             set tid {}
9774             foreach t $arctags($a) {
9775                 set j [lsearch -exact $arcids($a) $t]
9776                 if {$j >= $i} break
9777                 set tid $t
9778             }
9779             if {$tid ne {}} {
9780                 return $tid
9781             }
9782         }
9783         set id $arcstart($a)
9784         if {[info exists idtags($id)]} {
9785             return $id
9786         }
9787     }
9788     if {[info exists cached_dtags($id)]} {
9789         return $cached_dtags($id)
9790     }
9791
9792     set origid $id
9793     set todo [list $id]
9794     set queued($id) 1
9795     set nc 1
9796     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
9797         set id [lindex $todo $i]
9798         set done($id) 1
9799         set ta [info exists hastaggedancestor($id)]
9800         if {!$ta} {
9801             incr nc -1
9802         }
9803         # ignore tags on starting node
9804         if {!$ta && $i > 0} {
9805             if {[info exists idtags($id)]} {
9806                 set tagloc($id) $id
9807                 set ta 1
9808             } elseif {[info exists cached_dtags($id)]} {
9809                 set tagloc($id) $cached_dtags($id)
9810                 set ta 1
9811             }
9812         }
9813         foreach a $arcnos($id) {
9814             set d $arcstart($a)
9815             if {!$ta && $arctags($a) ne {}} {
9816                 validate_arctags $a
9817                 if {$arctags($a) ne {}} {
9818                     lappend tagloc($id) [lindex $arctags($a) end]
9819                 }
9820             }
9821             if {$ta || $arctags($a) ne {}} {
9822                 set tomark [list $d]
9823                 for {set j 0} {$j < [llength $tomark]} {incr j} {
9824                     set dd [lindex $tomark $j]
9825                     if {![info exists hastaggedancestor($dd)]} {
9826                         if {[info exists done($dd)]} {
9827                             foreach b $arcnos($dd) {
9828                                 lappend tomark $arcstart($b)
9829                             }
9830                             if {[info exists tagloc($dd)]} {
9831                                 unset tagloc($dd)
9832                             }
9833                         } elseif {[info exists queued($dd)]} {
9834                             incr nc -1
9835                         }
9836                         set hastaggedancestor($dd) 1
9837                     }
9838                 }
9839             }
9840             if {![info exists queued($d)]} {
9841                 lappend todo $d
9842                 set queued($d) 1
9843                 if {![info exists hastaggedancestor($d)]} {
9844                     incr nc
9845                 }
9846             }
9847         }
9848     }
9849     set tags {}
9850     foreach id [array names tagloc] {
9851         if {![info exists hastaggedancestor($id)]} {
9852             foreach t $tagloc($id) {
9853                 if {[lsearch -exact $tags $t] < 0} {
9854                     lappend tags $t
9855                 }
9856             }
9857         }
9858     }
9859     set t2 [clock clicks -milliseconds]
9860     set loopix $i
9861
9862     # remove tags that are descendents of other tags
9863     for {set i 0} {$i < [llength $tags]} {incr i} {
9864         set a [lindex $tags $i]
9865         for {set j 0} {$j < $i} {incr j} {
9866             set b [lindex $tags $j]
9867             set r [anc_or_desc $a $b]
9868             if {$r == 1} {
9869                 set tags [lreplace $tags $j $j]
9870                 incr j -1
9871                 incr i -1
9872             } elseif {$r == -1} {
9873                 set tags [lreplace $tags $i $i]
9874                 incr i -1
9875                 break
9876             }
9877         }
9878     }
9879
9880     if {[array names growing] ne {}} {
9881         # graph isn't finished, need to check if any tag could get
9882         # eclipsed by another tag coming later.  Simply ignore any
9883         # tags that could later get eclipsed.
9884         set ctags {}
9885         foreach t $tags {
9886             if {[is_certain $t $origid]} {
9887                 lappend ctags $t
9888             }
9889         }
9890         if {$tags eq $ctags} {
9891             set cached_dtags($origid) $tags
9892         } else {
9893             set tags $ctags
9894         }
9895     } else {
9896         set cached_dtags($origid) $tags
9897     }
9898     set t3 [clock clicks -milliseconds]
9899     if {0 && $t3 - $t1 >= 100} {
9900         puts "iterating descendents ($loopix/[llength $todo] nodes) took\
9901             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
9902     }
9903     return $tags
9904 }
9905
9906 proc anctags {id} {
9907     global arcnos arcids arcout arcend arctags idtags allparents
9908     global growing cached_atags
9909
9910     if {![info exists allparents($id)]} {
9911         return {}
9912     }
9913     set t1 [clock clicks -milliseconds]
9914     set argid $id
9915     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9916         # part-way along an arc; check that arc first
9917         set a [lindex $arcnos($id) 0]
9918         if {$arctags($a) ne {}} {
9919             validate_arctags $a
9920             set i [lsearch -exact $arcids($a) $id]
9921             foreach t $arctags($a) {
9922                 set j [lsearch -exact $arcids($a) $t]
9923                 if {$j > $i} {
9924                     return $t
9925                 }
9926             }
9927         }
9928         if {![info exists arcend($a)]} {
9929             return {}
9930         }
9931         set id $arcend($a)
9932         if {[info exists idtags($id)]} {
9933             return $id
9934         }
9935     }
9936     if {[info exists cached_atags($id)]} {
9937         return $cached_atags($id)
9938     }
9939
9940     set origid $id
9941     set todo [list $id]
9942     set queued($id) 1
9943     set taglist {}
9944     set nc 1
9945     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
9946         set id [lindex $todo $i]
9947         set done($id) 1
9948         set td [info exists hastaggeddescendent($id)]
9949         if {!$td} {
9950             incr nc -1
9951         }
9952         # ignore tags on starting node
9953         if {!$td && $i > 0} {
9954             if {[info exists idtags($id)]} {
9955                 set tagloc($id) $id
9956                 set td 1
9957             } elseif {[info exists cached_atags($id)]} {
9958                 set tagloc($id) $cached_atags($id)
9959                 set td 1
9960             }
9961         }
9962         foreach a $arcout($id) {
9963             if {!$td && $arctags($a) ne {}} {
9964                 validate_arctags $a
9965                 if {$arctags($a) ne {}} {
9966                     lappend tagloc($id) [lindex $arctags($a) 0]
9967                 }
9968             }
9969             if {![info exists arcend($a)]} continue
9970             set d $arcend($a)
9971             if {$td || $arctags($a) ne {}} {
9972                 set tomark [list $d]
9973                 for {set j 0} {$j < [llength $tomark]} {incr j} {
9974                     set dd [lindex $tomark $j]
9975                     if {![info exists hastaggeddescendent($dd)]} {
9976                         if {[info exists done($dd)]} {
9977                             foreach b $arcout($dd) {
9978                                 if {[info exists arcend($b)]} {
9979                                     lappend tomark $arcend($b)
9980                                 }
9981                             }
9982                             if {[info exists tagloc($dd)]} {
9983                                 unset tagloc($dd)
9984                             }
9985                         } elseif {[info exists queued($dd)]} {
9986                             incr nc -1
9987                         }
9988                         set hastaggeddescendent($dd) 1
9989                     }
9990                 }
9991             }
9992             if {![info exists queued($d)]} {
9993                 lappend todo $d
9994                 set queued($d) 1
9995                 if {![info exists hastaggeddescendent($d)]} {
9996                     incr nc
9997                 }
9998             }
9999         }
10000     }
10001     set t2 [clock clicks -milliseconds]
10002     set loopix $i
10003     set tags {}
10004     foreach id [array names tagloc] {
10005         if {![info exists hastaggeddescendent($id)]} {
10006             foreach t $tagloc($id) {
10007                 if {[lsearch -exact $tags $t] < 0} {
10008                     lappend tags $t
10009                 }
10010             }
10011         }
10012     }
10013
10014     # remove tags that are ancestors of other tags
10015     for {set i 0} {$i < [llength $tags]} {incr i} {
10016         set a [lindex $tags $i]
10017         for {set j 0} {$j < $i} {incr j} {
10018             set b [lindex $tags $j]
10019             set r [anc_or_desc $a $b]
10020             if {$r == -1} {
10021                 set tags [lreplace $tags $j $j]
10022                 incr j -1
10023                 incr i -1
10024             } elseif {$r == 1} {
10025                 set tags [lreplace $tags $i $i]
10026                 incr i -1
10027                 break
10028             }
10029         }
10030     }
10031
10032     if {[array names growing] ne {}} {
10033         # graph isn't finished, need to check if any tag could get
10034         # eclipsed by another tag coming later.  Simply ignore any
10035         # tags that could later get eclipsed.
10036         set ctags {}
10037         foreach t $tags {
10038             if {[is_certain $origid $t]} {
10039                 lappend ctags $t
10040             }
10041         }
10042         if {$tags eq $ctags} {
10043             set cached_atags($origid) $tags
10044         } else {
10045             set tags $ctags
10046         }
10047     } else {
10048         set cached_atags($origid) $tags
10049     }
10050     set t3 [clock clicks -milliseconds]
10051     if {0 && $t3 - $t1 >= 100} {
10052         puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
10053             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10054     }
10055     return $tags
10056 }
10057
10058 # Return the list of IDs that have heads that are descendents of id,
10059 # including id itself if it has a head.
10060 proc descheads {id} {
10061     global arcnos arcstart arcids archeads idheads cached_dheads
10062     global allparents
10063
10064     if {![info exists allparents($id)]} {
10065         return {}
10066     }
10067     set aret {}
10068     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10069         # part-way along an arc; check it first
10070         set a [lindex $arcnos($id) 0]
10071         if {$archeads($a) ne {}} {
10072             validate_archeads $a
10073             set i [lsearch -exact $arcids($a) $id]
10074             foreach t $archeads($a) {
10075                 set j [lsearch -exact $arcids($a) $t]
10076                 if {$j > $i} break
10077                 lappend aret $t
10078             }
10079         }
10080         set id $arcstart($a)
10081     }
10082     set origid $id
10083     set todo [list $id]
10084     set seen($id) 1
10085     set ret {}
10086     for {set i 0} {$i < [llength $todo]} {incr i} {
10087         set id [lindex $todo $i]
10088         if {[info exists cached_dheads($id)]} {
10089             set ret [concat $ret $cached_dheads($id)]
10090         } else {
10091             if {[info exists idheads($id)]} {
10092                 lappend ret $id
10093             }
10094             foreach a $arcnos($id) {
10095                 if {$archeads($a) ne {}} {
10096                     validate_archeads $a
10097                     if {$archeads($a) ne {}} {
10098                         set ret [concat $ret $archeads($a)]
10099                     }
10100                 }
10101                 set d $arcstart($a)
10102                 if {![info exists seen($d)]} {
10103                     lappend todo $d
10104                     set seen($d) 1
10105                 }
10106             }
10107         }
10108     }
10109     set ret [lsort -unique $ret]
10110     set cached_dheads($origid) $ret
10111     return [concat $ret $aret]
10112 }
10113
10114 proc addedtag {id} {
10115     global arcnos arcout cached_dtags cached_atags
10116
10117     if {![info exists arcnos($id)]} return
10118     if {![info exists arcout($id)]} {
10119         recalcarc [lindex $arcnos($id) 0]
10120     }
10121     catch {unset cached_dtags}
10122     catch {unset cached_atags}
10123 }
10124
10125 proc addedhead {hid head} {
10126     global arcnos arcout cached_dheads
10127
10128     if {![info exists arcnos($hid)]} return
10129     if {![info exists arcout($hid)]} {
10130         recalcarc [lindex $arcnos($hid) 0]
10131     }
10132     catch {unset cached_dheads}
10133 }
10134
10135 proc removedhead {hid head} {
10136     global cached_dheads
10137
10138     catch {unset cached_dheads}
10139 }
10140
10141 proc movedhead {hid head} {
10142     global arcnos arcout cached_dheads
10143
10144     if {![info exists arcnos($hid)]} return
10145     if {![info exists arcout($hid)]} {
10146         recalcarc [lindex $arcnos($hid) 0]
10147     }
10148     catch {unset cached_dheads}
10149 }
10150
10151 proc changedrefs {} {
10152     global cached_dheads cached_dtags cached_atags
10153     global arctags archeads arcnos arcout idheads idtags
10154
10155     foreach id [concat [array names idheads] [array names idtags]] {
10156         if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
10157             set a [lindex $arcnos($id) 0]
10158             if {![info exists donearc($a)]} {
10159                 recalcarc $a
10160                 set donearc($a) 1
10161             }
10162         }
10163     }
10164     catch {unset cached_dtags}
10165     catch {unset cached_atags}
10166     catch {unset cached_dheads}
10167 }
10168
10169 proc rereadrefs {} {
10170     global idtags idheads idotherrefs mainheadid
10171
10172     set refids [concat [array names idtags] \
10173                     [array names idheads] [array names idotherrefs]]
10174     foreach id $refids {
10175         if {![info exists ref($id)]} {
10176             set ref($id) [listrefs $id]
10177         }
10178     }
10179     set oldmainhead $mainheadid
10180     readrefs
10181     changedrefs
10182     set refids [lsort -unique [concat $refids [array names idtags] \
10183                         [array names idheads] [array names idotherrefs]]]
10184     foreach id $refids {
10185         set v [listrefs $id]
10186         if {![info exists ref($id)] || $ref($id) != $v} {
10187             redrawtags $id
10188         }
10189     }
10190     if {$oldmainhead ne $mainheadid} {
10191         redrawtags $oldmainhead
10192         redrawtags $mainheadid
10193     }
10194     run refill_reflist
10195 }
10196
10197 proc listrefs {id} {
10198     global idtags idheads idotherrefs
10199
10200     set x {}
10201     if {[info exists idtags($id)]} {
10202         set x $idtags($id)
10203     }
10204     set y {}
10205     if {[info exists idheads($id)]} {
10206         set y $idheads($id)
10207     }
10208     set z {}
10209     if {[info exists idotherrefs($id)]} {
10210         set z $idotherrefs($id)
10211     }
10212     return [list $x $y $z]
10213 }
10214
10215 proc showtag {tag isnew} {
10216     global ctext tagcontents tagids linknum tagobjid
10217
10218     if {$isnew} {
10219         addtohistory [list showtag $tag 0]
10220     }
10221     $ctext conf -state normal
10222     clear_ctext
10223     settabs 0
10224     set linknum 0
10225     if {![info exists tagcontents($tag)]} {
10226         catch {
10227             set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
10228         }
10229     }
10230     if {[info exists tagcontents($tag)]} {
10231         set text $tagcontents($tag)
10232     } else {
10233         set text "[mc "Tag"]: $tag\n[mc "Id"]:  $tagids($tag)"
10234     }
10235     appendwithlinks $text {}
10236     $ctext conf -state disabled
10237     init_flist {}
10238 }
10239
10240 proc doquit {} {
10241     global stopped
10242     global gitktmpdir
10243
10244     set stopped 100
10245     savestuff .
10246     destroy .
10247
10248     if {[info exists gitktmpdir]} {
10249         catch {file delete -force $gitktmpdir}
10250     }
10251 }
10252
10253 proc mkfontdisp {font top which} {
10254     global fontattr fontpref $font
10255
10256     set fontpref($font) [set $font]
10257     button $top.${font}but -text $which -font optionfont \
10258         -command [list choosefont $font $which]
10259     label $top.$font -relief flat -font $font \
10260         -text $fontattr($font,family) -justify left
10261     grid x $top.${font}but $top.$font -sticky w
10262 }
10263
10264 proc choosefont {font which} {
10265     global fontparam fontlist fonttop fontattr
10266     global prefstop
10267
10268     set fontparam(which) $which
10269     set fontparam(font) $font
10270     set fontparam(family) [font actual $font -family]
10271     set fontparam(size) $fontattr($font,size)
10272     set fontparam(weight) $fontattr($font,weight)
10273     set fontparam(slant) $fontattr($font,slant)
10274     set top .gitkfont
10275     set fonttop $top
10276     if {![winfo exists $top]} {
10277         font create sample
10278         eval font config sample [font actual $font]
10279         toplevel $top
10280         make_transient $top $prefstop
10281         wm title $top [mc "Gitk font chooser"]
10282         label $top.l -textvariable fontparam(which)
10283         pack $top.l -side top
10284         set fontlist [lsort [font families]]
10285         frame $top.f
10286         listbox $top.f.fam -listvariable fontlist \
10287             -yscrollcommand [list $top.f.sb set]
10288         bind $top.f.fam <<ListboxSelect>> selfontfam
10289         scrollbar $top.f.sb -command [list $top.f.fam yview]
10290         pack $top.f.sb -side right -fill y
10291         pack $top.f.fam -side left -fill both -expand 1
10292         pack $top.f -side top -fill both -expand 1
10293         frame $top.g
10294         spinbox $top.g.size -from 4 -to 40 -width 4 \
10295             -textvariable fontparam(size) \
10296             -validatecommand {string is integer -strict %s}
10297         checkbutton $top.g.bold -padx 5 \
10298             -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
10299             -variable fontparam(weight) -onvalue bold -offvalue normal
10300         checkbutton $top.g.ital -padx 5 \
10301             -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
10302             -variable fontparam(slant) -onvalue italic -offvalue roman
10303         pack $top.g.size $top.g.bold $top.g.ital -side left
10304         pack $top.g -side top
10305         canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
10306             -background white
10307         $top.c create text 100 25 -anchor center -text $which -font sample \
10308             -fill black -tags text
10309         bind $top.c <Configure> [list centertext $top.c]
10310         pack $top.c -side top -fill x
10311         frame $top.buts
10312         button $top.buts.ok -text [mc "OK"] -command fontok -default active
10313         button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
10314         bind $top <Key-Return> fontok
10315         bind $top <Key-Escape> fontcan
10316         grid $top.buts.ok $top.buts.can
10317         grid columnconfigure $top.buts 0 -weight 1 -uniform a
10318         grid columnconfigure $top.buts 1 -weight 1 -uniform a
10319         pack $top.buts -side bottom -fill x
10320         trace add variable fontparam write chg_fontparam
10321     } else {
10322         raise $top
10323         $top.c itemconf text -text $which
10324     }
10325     set i [lsearch -exact $fontlist $fontparam(family)]
10326     if {$i >= 0} {
10327         $top.f.fam selection set $i
10328         $top.f.fam see $i
10329     }
10330 }
10331
10332 proc centertext {w} {
10333     $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
10334 }
10335
10336 proc fontok {} {
10337     global fontparam fontpref prefstop
10338
10339     set f $fontparam(font)
10340     set fontpref($f) [list $fontparam(family) $fontparam(size)]
10341     if {$fontparam(weight) eq "bold"} {
10342         lappend fontpref($f) "bold"
10343     }
10344     if {$fontparam(slant) eq "italic"} {
10345         lappend fontpref($f) "italic"
10346     }
10347     set w $prefstop.$f
10348     $w conf -text $fontparam(family) -font $fontpref($f)
10349
10350     fontcan
10351 }
10352
10353 proc fontcan {} {
10354     global fonttop fontparam
10355
10356     if {[info exists fonttop]} {
10357         catch {destroy $fonttop}
10358         catch {font delete sample}
10359         unset fonttop
10360         unset fontparam
10361     }
10362 }
10363
10364 proc selfontfam {} {
10365     global fonttop fontparam
10366
10367     set i [$fonttop.f.fam curselection]
10368     if {$i ne {}} {
10369         set fontparam(family) [$fonttop.f.fam get $i]
10370     }
10371 }
10372
10373 proc chg_fontparam {v sub op} {
10374     global fontparam
10375
10376     font config sample -$sub $fontparam($sub)
10377 }
10378
10379 proc doprefs {} {
10380     global maxwidth maxgraphpct
10381     global oldprefs prefstop showneartags showlocalchanges
10382     global bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
10383     global tabstop limitdiffs autoselect extdifftool perfile_attrs
10384
10385     set top .gitkprefs
10386     set prefstop $top
10387     if {[winfo exists $top]} {
10388         raise $top
10389         return
10390     }
10391     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
10392                    limitdiffs tabstop perfile_attrs} {
10393         set oldprefs($v) [set $v]
10394     }
10395     toplevel $top
10396     wm title $top [mc "Gitk preferences"]
10397     make_transient $top .
10398     label $top.ldisp -text [mc "Commit list display options"]
10399     grid $top.ldisp - -sticky w -pady 10
10400     label $top.spacer -text " "
10401     label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
10402         -font optionfont
10403     spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
10404     grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
10405     label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
10406         -font optionfont
10407     spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
10408     grid x $top.maxpctl $top.maxpct -sticky w
10409     checkbutton $top.showlocal -text [mc "Show local changes"] \
10410         -font optionfont -variable showlocalchanges
10411     grid x $top.showlocal -sticky w
10412     checkbutton $top.autoselect -text [mc "Auto-select SHA1"] \
10413         -font optionfont -variable autoselect
10414     grid x $top.autoselect -sticky w
10415
10416     label $top.ddisp -text [mc "Diff display options"]
10417     grid $top.ddisp - -sticky w -pady 10
10418     label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
10419     spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
10420     grid x $top.tabstopl $top.tabstop -sticky w
10421     checkbutton $top.ntag -text [mc "Display nearby tags"] \
10422         -font optionfont -variable showneartags
10423     grid x $top.ntag -sticky w
10424     checkbutton $top.ldiff -text [mc "Limit diffs to listed paths"] \
10425         -font optionfont -variable limitdiffs
10426     grid x $top.ldiff -sticky w
10427     checkbutton $top.lattr -text [mc "Support per-file encodings"] \
10428         -font optionfont -variable perfile_attrs
10429     grid x $top.lattr -sticky w
10430
10431     entry $top.extdifft -textvariable extdifftool
10432     frame $top.extdifff
10433     label $top.extdifff.l -text [mc "External diff tool" ] -font optionfont \
10434         -padx 10
10435     button $top.extdifff.b -text [mc "Choose..."] -font optionfont \
10436         -command choose_extdiff
10437     pack $top.extdifff.l $top.extdifff.b -side left
10438     grid x $top.extdifff $top.extdifft -sticky w
10439
10440     label $top.cdisp -text [mc "Colors: press to choose"]
10441     grid $top.cdisp - -sticky w -pady 10
10442     label $top.bg -padx 40 -relief sunk -background $bgcolor
10443     button $top.bgbut -text [mc "Background"] -font optionfont \
10444         -command [list choosecolor bgcolor {} $top.bg [mc "background"] setbg]
10445     grid x $top.bgbut $top.bg -sticky w
10446     label $top.fg -padx 40 -relief sunk -background $fgcolor
10447     button $top.fgbut -text [mc "Foreground"] -font optionfont \
10448         -command [list choosecolor fgcolor {} $top.fg [mc "foreground"] setfg]
10449     grid x $top.fgbut $top.fg -sticky w
10450     label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
10451     button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
10452         -command [list choosecolor diffcolors 0 $top.diffold [mc "diff old lines"] \
10453                       [list $ctext tag conf d0 -foreground]]
10454     grid x $top.diffoldbut $top.diffold -sticky w
10455     label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
10456     button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
10457         -command [list choosecolor diffcolors 1 $top.diffnew [mc "diff new lines"] \
10458                       [list $ctext tag conf dresult -foreground]]
10459     grid x $top.diffnewbut $top.diffnew -sticky w
10460     label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
10461     button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
10462         -command [list choosecolor diffcolors 2 $top.hunksep \
10463                       [mc "diff hunk header"] \
10464                       [list $ctext tag conf hunksep -foreground]]
10465     grid x $top.hunksepbut $top.hunksep -sticky w
10466     label $top.markbgsep -padx 40 -relief sunk -background $markbgcolor
10467     button $top.markbgbut -text [mc "Marked line bg"] -font optionfont \
10468         -command [list choosecolor markbgcolor {} $top.markbgsep \
10469                       [mc "marked line background"] \
10470                       [list $ctext tag conf omark -background]]
10471     grid x $top.markbgbut $top.markbgsep -sticky w
10472     label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
10473     button $top.selbgbut -text [mc "Select bg"] -font optionfont \
10474         -command [list choosecolor selectbgcolor {} $top.selbgsep [mc "background"] setselbg]
10475     grid x $top.selbgbut $top.selbgsep -sticky w
10476
10477     label $top.cfont -text [mc "Fonts: press to choose"]
10478     grid $top.cfont - -sticky w -pady 10
10479     mkfontdisp mainfont $top [mc "Main font"]
10480     mkfontdisp textfont $top [mc "Diff display font"]
10481     mkfontdisp uifont $top [mc "User interface font"]
10482
10483     frame $top.buts
10484     button $top.buts.ok -text [mc "OK"] -command prefsok -default active
10485     button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
10486     bind $top <Key-Return> prefsok
10487     bind $top <Key-Escape> prefscan
10488     grid $top.buts.ok $top.buts.can
10489     grid columnconfigure $top.buts 0 -weight 1 -uniform a
10490     grid columnconfigure $top.buts 1 -weight 1 -uniform a
10491     grid $top.buts - - -pady 10 -sticky ew
10492     bind $top <Visibility> "focus $top.buts.ok"
10493 }
10494
10495 proc choose_extdiff {} {
10496     global extdifftool
10497
10498     set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
10499     if {$prog ne {}} {
10500         set extdifftool $prog
10501     }
10502 }
10503
10504 proc choosecolor {v vi w x cmd} {
10505     global $v
10506
10507     set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
10508                -title [mc "Gitk: choose color for %s" $x]]
10509     if {$c eq {}} return
10510     $w conf -background $c
10511     lset $v $vi $c
10512     eval $cmd $c
10513 }
10514
10515 proc setselbg {c} {
10516     global bglist cflist
10517     foreach w $bglist {
10518         $w configure -selectbackground $c
10519     }
10520     $cflist tag configure highlight \
10521         -background [$cflist cget -selectbackground]
10522     allcanvs itemconf secsel -fill $c
10523 }
10524
10525 proc setbg {c} {
10526     global bglist
10527
10528     foreach w $bglist {
10529         $w conf -background $c
10530     }
10531 }
10532
10533 proc setfg {c} {
10534     global fglist canv
10535
10536     foreach w $fglist {
10537         $w conf -foreground $c
10538     }
10539     allcanvs itemconf text -fill $c
10540     $canv itemconf circle -outline $c
10541     $canv itemconf markid -outline $c
10542 }
10543
10544 proc prefscan {} {
10545     global oldprefs prefstop
10546
10547     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
10548                    limitdiffs tabstop perfile_attrs} {
10549         global $v
10550         set $v $oldprefs($v)
10551     }
10552     catch {destroy $prefstop}
10553     unset prefstop
10554     fontcan
10555 }
10556
10557 proc prefsok {} {
10558     global maxwidth maxgraphpct
10559     global oldprefs prefstop showneartags showlocalchanges
10560     global fontpref mainfont textfont uifont
10561     global limitdiffs treediffs perfile_attrs
10562
10563     catch {destroy $prefstop}
10564     unset prefstop
10565     fontcan
10566     set fontchanged 0
10567     if {$mainfont ne $fontpref(mainfont)} {
10568         set mainfont $fontpref(mainfont)
10569         parsefont mainfont $mainfont
10570         eval font configure mainfont [fontflags mainfont]
10571         eval font configure mainfontbold [fontflags mainfont 1]
10572         setcoords
10573         set fontchanged 1
10574     }
10575     if {$textfont ne $fontpref(textfont)} {
10576         set textfont $fontpref(textfont)
10577         parsefont textfont $textfont
10578         eval font configure textfont [fontflags textfont]
10579         eval font configure textfontbold [fontflags textfont 1]
10580     }
10581     if {$uifont ne $fontpref(uifont)} {
10582         set uifont $fontpref(uifont)
10583         parsefont uifont $uifont
10584         eval font configure uifont [fontflags uifont]
10585     }
10586     settabs
10587     if {$showlocalchanges != $oldprefs(showlocalchanges)} {
10588         if {$showlocalchanges} {
10589             doshowlocalchanges
10590         } else {
10591             dohidelocalchanges
10592         }
10593     }
10594     if {$limitdiffs != $oldprefs(limitdiffs) ||
10595         ($perfile_attrs && !$oldprefs(perfile_attrs))} {
10596         # treediffs elements are limited by path;
10597         # won't have encodings cached if perfile_attrs was just turned on
10598         catch {unset treediffs}
10599     }
10600     if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
10601         || $maxgraphpct != $oldprefs(maxgraphpct)} {
10602         redisplay
10603     } elseif {$showneartags != $oldprefs(showneartags) ||
10604           $limitdiffs != $oldprefs(limitdiffs)} {
10605         reselectline
10606     }
10607 }
10608
10609 proc formatdate {d} {
10610     global datetimeformat
10611     if {$d ne {}} {
10612         set d [clock format $d -format $datetimeformat]
10613     }
10614     return $d
10615 }
10616
10617 # This list of encoding names and aliases is distilled from
10618 # http://www.iana.org/assignments/character-sets.
10619 # Not all of them are supported by Tcl.
10620 set encoding_aliases {
10621     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
10622       ISO646-US US-ASCII us IBM367 cp367 csASCII }
10623     { ISO-10646-UTF-1 csISO10646UTF1 }
10624     { ISO_646.basic:1983 ref csISO646basic1983 }
10625     { INVARIANT csINVARIANT }
10626     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
10627     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
10628     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
10629     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
10630     { NATS-DANO iso-ir-9-1 csNATSDANO }
10631     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
10632     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
10633     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
10634     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
10635     { ISO-2022-KR csISO2022KR }
10636     { EUC-KR csEUCKR }
10637     { ISO-2022-JP csISO2022JP }
10638     { ISO-2022-JP-2 csISO2022JP2 }
10639     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
10640       csISO13JISC6220jp }
10641     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
10642     { IT iso-ir-15 ISO646-IT csISO15Italian }
10643     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
10644     { ES iso-ir-17 ISO646-ES csISO17Spanish }
10645     { greek7-old iso-ir-18 csISO18Greek7Old }
10646     { latin-greek iso-ir-19 csISO19LatinGreek }
10647     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
10648     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
10649     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
10650     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
10651     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
10652     { BS_viewdata iso-ir-47 csISO47BSViewdata }
10653     { INIS iso-ir-49 csISO49INIS }
10654     { INIS-8 iso-ir-50 csISO50INIS8 }
10655     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
10656     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
10657     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
10658     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
10659     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
10660     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
10661       csISO60Norwegian1 }
10662     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
10663     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
10664     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
10665     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
10666     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
10667     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
10668     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
10669     { greek7 iso-ir-88 csISO88Greek7 }
10670     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
10671     { iso-ir-90 csISO90 }
10672     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
10673     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
10674       csISO92JISC62991984b }
10675     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
10676     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
10677     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
10678       csISO95JIS62291984handadd }
10679     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
10680     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
10681     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
10682     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
10683       CP819 csISOLatin1 }
10684     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
10685     { T.61-7bit iso-ir-102 csISO102T617bit }
10686     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
10687     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
10688     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
10689     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
10690     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
10691     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
10692     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
10693     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
10694       arabic csISOLatinArabic }
10695     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
10696     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
10697     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
10698       greek greek8 csISOLatinGreek }
10699     { T.101-G2 iso-ir-128 csISO128T101G2 }
10700     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
10701       csISOLatinHebrew }
10702     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
10703     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
10704     { CSN_369103 iso-ir-139 csISO139CSN369103 }
10705     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
10706     { ISO_6937-2-add iso-ir-142 csISOTextComm }
10707     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
10708     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
10709       csISOLatinCyrillic }
10710     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
10711     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
10712     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
10713     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
10714     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
10715     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
10716     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
10717     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
10718     { ISO_10367-box iso-ir-155 csISO10367Box }
10719     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
10720     { latin-lap lap iso-ir-158 csISO158Lap }
10721     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
10722     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
10723     { us-dk csUSDK }
10724     { dk-us csDKUS }
10725     { JIS_X0201 X0201 csHalfWidthKatakana }
10726     { KSC5636 ISO646-KR csKSC5636 }
10727     { ISO-10646-UCS-2 csUnicode }
10728     { ISO-10646-UCS-4 csUCS4 }
10729     { DEC-MCS dec csDECMCS }
10730     { hp-roman8 roman8 r8 csHPRoman8 }
10731     { macintosh mac csMacintosh }
10732     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
10733       csIBM037 }
10734     { IBM038 EBCDIC-INT cp038 csIBM038 }
10735     { IBM273 CP273 csIBM273 }
10736     { IBM274 EBCDIC-BE CP274 csIBM274 }
10737     { IBM275 EBCDIC-BR cp275 csIBM275 }
10738     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
10739     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
10740     { IBM280 CP280 ebcdic-cp-it csIBM280 }
10741     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
10742     { IBM284 CP284 ebcdic-cp-es csIBM284 }
10743     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
10744     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
10745     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
10746     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
10747     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
10748     { IBM424 cp424 ebcdic-cp-he csIBM424 }
10749     { IBM437 cp437 437 csPC8CodePage437 }
10750     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
10751     { IBM775 cp775 csPC775Baltic }
10752     { IBM850 cp850 850 csPC850Multilingual }
10753     { IBM851 cp851 851 csIBM851 }
10754     { IBM852 cp852 852 csPCp852 }
10755     { IBM855 cp855 855 csIBM855 }
10756     { IBM857 cp857 857 csIBM857 }
10757     { IBM860 cp860 860 csIBM860 }
10758     { IBM861 cp861 861 cp-is csIBM861 }
10759     { IBM862 cp862 862 csPC862LatinHebrew }
10760     { IBM863 cp863 863 csIBM863 }
10761     { IBM864 cp864 csIBM864 }
10762     { IBM865 cp865 865 csIBM865 }
10763     { IBM866 cp866 866 csIBM866 }
10764     { IBM868 CP868 cp-ar csIBM868 }
10765     { IBM869 cp869 869 cp-gr csIBM869 }
10766     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
10767     { IBM871 CP871 ebcdic-cp-is csIBM871 }
10768     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
10769     { IBM891 cp891 csIBM891 }
10770     { IBM903 cp903 csIBM903 }
10771     { IBM904 cp904 904 csIBBM904 }
10772     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
10773     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
10774     { IBM1026 CP1026 csIBM1026 }
10775     { EBCDIC-AT-DE csIBMEBCDICATDE }
10776     { EBCDIC-AT-DE-A csEBCDICATDEA }
10777     { EBCDIC-CA-FR csEBCDICCAFR }
10778     { EBCDIC-DK-NO csEBCDICDKNO }
10779     { EBCDIC-DK-NO-A csEBCDICDKNOA }
10780     { EBCDIC-FI-SE csEBCDICFISE }
10781     { EBCDIC-FI-SE-A csEBCDICFISEA }
10782     { EBCDIC-FR csEBCDICFR }
10783     { EBCDIC-IT csEBCDICIT }
10784     { EBCDIC-PT csEBCDICPT }
10785     { EBCDIC-ES csEBCDICES }
10786     { EBCDIC-ES-A csEBCDICESA }
10787     { EBCDIC-ES-S csEBCDICESS }
10788     { EBCDIC-UK csEBCDICUK }
10789     { EBCDIC-US csEBCDICUS }
10790     { UNKNOWN-8BIT csUnknown8BiT }
10791     { MNEMONIC csMnemonic }
10792     { MNEM csMnem }
10793     { VISCII csVISCII }
10794     { VIQR csVIQR }
10795     { KOI8-R csKOI8R }
10796     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
10797     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
10798     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
10799     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
10800     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
10801     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
10802     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
10803     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
10804     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
10805     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
10806     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
10807     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
10808     { IBM1047 IBM-1047 }
10809     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
10810     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
10811     { UNICODE-1-1 csUnicode11 }
10812     { CESU-8 csCESU-8 }
10813     { BOCU-1 csBOCU-1 }
10814     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
10815     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
10816       l8 }
10817     { ISO-8859-15 ISO_8859-15 Latin-9 }
10818     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
10819     { GBK CP936 MS936 windows-936 }
10820     { JIS_Encoding csJISEncoding }
10821     { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
10822     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
10823       EUC-JP }
10824     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
10825     { ISO-10646-UCS-Basic csUnicodeASCII }
10826     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
10827     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
10828     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
10829     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
10830     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
10831     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
10832     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
10833     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
10834     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
10835     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
10836     { Adobe-Standard-Encoding csAdobeStandardEncoding }
10837     { Ventura-US csVenturaUS }
10838     { Ventura-International csVenturaInternational }
10839     { PC8-Danish-Norwegian csPC8DanishNorwegian }
10840     { PC8-Turkish csPC8Turkish }
10841     { IBM-Symbols csIBMSymbols }
10842     { IBM-Thai csIBMThai }
10843     { HP-Legal csHPLegal }
10844     { HP-Pi-font csHPPiFont }
10845     { HP-Math8 csHPMath8 }
10846     { Adobe-Symbol-Encoding csHPPSMath }
10847     { HP-DeskTop csHPDesktop }
10848     { Ventura-Math csVenturaMath }
10849     { Microsoft-Publishing csMicrosoftPublishing }
10850     { Windows-31J csWindows31J }
10851     { GB2312 csGB2312 }
10852     { Big5 csBig5 }
10853 }
10854
10855 proc tcl_encoding {enc} {
10856     global encoding_aliases tcl_encoding_cache
10857     if {[info exists tcl_encoding_cache($enc)]} {
10858         return $tcl_encoding_cache($enc)
10859     }
10860     set names [encoding names]
10861     set lcnames [string tolower $names]
10862     set enc [string tolower $enc]
10863     set i [lsearch -exact $lcnames $enc]
10864     if {$i < 0} {
10865         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
10866         if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
10867             set i [lsearch -exact $lcnames $encx]
10868         }
10869     }
10870     if {$i < 0} {
10871         foreach l $encoding_aliases {
10872             set ll [string tolower $l]
10873             if {[lsearch -exact $ll $enc] < 0} continue
10874             # look through the aliases for one that tcl knows about
10875             foreach e $ll {
10876                 set i [lsearch -exact $lcnames $e]
10877                 if {$i < 0} {
10878                     if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
10879                         set i [lsearch -exact $lcnames $ex]
10880                     }
10881                 }
10882                 if {$i >= 0} break
10883             }
10884             break
10885         }
10886     }
10887     set tclenc {}
10888     if {$i >= 0} {
10889         set tclenc [lindex $names $i]
10890     }
10891     set tcl_encoding_cache($enc) $tclenc
10892     return $tclenc
10893 }
10894
10895 proc gitattr {path attr default} {
10896     global path_attr_cache
10897     if {[info exists path_attr_cache($attr,$path)]} {
10898         set r $path_attr_cache($attr,$path)
10899     } else {
10900         set r "unspecified"
10901         if {![catch {set line [exec git check-attr $attr -- $path]}]} {
10902             regexp "(.*): encoding: (.*)" $line m f r
10903         }
10904         set path_attr_cache($attr,$path) $r
10905     }
10906     if {$r eq "unspecified"} {
10907         return $default
10908     }
10909     return $r
10910 }
10911
10912 proc cache_gitattr {attr pathlist} {
10913     global path_attr_cache
10914     set newlist {}
10915     foreach path $pathlist {
10916         if {![info exists path_attr_cache($attr,$path)]} {
10917             lappend newlist $path
10918         }
10919     }
10920     set lim 1000
10921     if {[tk windowingsystem] == "win32"} {
10922         # windows has a 32k limit on the arguments to a command...
10923         set lim 30
10924     }
10925     while {$newlist ne {}} {
10926         set head [lrange $newlist 0 [expr {$lim - 1}]]
10927         set newlist [lrange $newlist $lim end]
10928         if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
10929             foreach row [split $rlist "\n"] {
10930                 if {[regexp "(.*): encoding: (.*)" $row m path value]} {
10931                     if {[string index $path 0] eq "\""} {
10932                         set path [encoding convertfrom [lindex $path 0]]
10933                     }
10934                     set path_attr_cache($attr,$path) $value
10935                 }
10936             }
10937         }
10938     }
10939 }
10940
10941 proc get_path_encoding {path} {
10942     global gui_encoding perfile_attrs
10943     set tcl_enc $gui_encoding
10944     if {$path ne {} && $perfile_attrs} {
10945         set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
10946         if {$enc2 ne {}} {
10947             set tcl_enc $enc2
10948         }
10949     }
10950     return $tcl_enc
10951 }
10952
10953 # First check that Tcl/Tk is recent enough
10954 if {[catch {package require Tk 8.4} err]} {
10955     show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
10956                      Gitk requires at least Tcl/Tk 8.4."]
10957     exit 1
10958 }
10959
10960 # defaults...
10961 set wrcomcmd "git diff-tree --stdin -p --pretty"
10962
10963 set gitencoding {}
10964 catch {
10965     set gitencoding [exec git config --get i18n.commitencoding]
10966 }
10967 catch {
10968     set gitencoding [exec git config --get i18n.logoutputencoding]
10969 }
10970 if {$gitencoding == ""} {
10971     set gitencoding "utf-8"
10972 }
10973 set tclencoding [tcl_encoding $gitencoding]
10974 if {$tclencoding == {}} {
10975     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
10976 }
10977
10978 set gui_encoding [encoding system]
10979 catch {
10980     set enc [exec git config --get gui.encoding]
10981     if {$enc ne {}} {
10982         set tclenc [tcl_encoding $enc]
10983         if {$tclenc ne {}} {
10984             set gui_encoding $tclenc
10985         } else {
10986             puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
10987         }
10988     }
10989 }
10990
10991 if {[tk windowingsystem] eq "aqua"} {
10992     set mainfont {{Lucida Grande} 9}
10993     set textfont {Monaco 9}
10994     set uifont {{Lucida Grande} 9 bold}
10995 } else {
10996     set mainfont {Helvetica 9}
10997     set textfont {Courier 9}
10998     set uifont {Helvetica 9 bold}
10999 }
11000 set tabstop 8
11001 set findmergefiles 0
11002 set maxgraphpct 50
11003 set maxwidth 16
11004 set revlistorder 0
11005 set fastdate 0
11006 set uparrowlen 5
11007 set downarrowlen 5
11008 set mingaplen 100
11009 set cmitmode "patch"
11010 set wrapcomment "none"
11011 set showneartags 1
11012 set maxrefs 20
11013 set maxlinelen 200
11014 set showlocalchanges 1
11015 set limitdiffs 1
11016 set datetimeformat "%Y-%m-%d %H:%M:%S"
11017 set autoselect 1
11018 set perfile_attrs 0
11019
11020 if {[tk windowingsystem] eq "aqua"} {
11021     set extdifftool "opendiff"
11022 } else {
11023     set extdifftool "meld"
11024 }
11025
11026 set colors {green red blue magenta darkgrey brown orange}
11027 set bgcolor white
11028 set fgcolor black
11029 set diffcolors {red "#00a000" blue}
11030 set diffcontext 3
11031 set ignorespace 0
11032 set selectbgcolor gray85
11033 set markbgcolor "#e0e0ff"
11034
11035 set circlecolors {white blue gray blue blue}
11036
11037 # button for popping up context menus
11038 if {[tk windowingsystem] eq "aqua"} {
11039     set ctxbut <Button-2>
11040 } else {
11041     set ctxbut <Button-3>
11042 }
11043
11044 ## For msgcat loading, first locate the installation location.
11045 if { [info exists ::env(GITK_MSGSDIR)] } {
11046     ## Msgsdir was manually set in the environment.
11047     set gitk_msgsdir $::env(GITK_MSGSDIR)
11048 } else {
11049     ## Let's guess the prefix from argv0.
11050     set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
11051     set gitk_libdir [file join $gitk_prefix share gitk lib]
11052     set gitk_msgsdir [file join $gitk_libdir msgs]
11053     unset gitk_prefix
11054 }
11055
11056 ## Internationalization (i18n) through msgcat and gettext. See
11057 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
11058 package require msgcat
11059 namespace import ::msgcat::mc
11060 ## And eventually load the actual message catalog
11061 ::msgcat::mcload $gitk_msgsdir
11062
11063 catch {source ~/.gitk}
11064
11065 font create optionfont -family sans-serif -size -12
11066
11067 parsefont mainfont $mainfont
11068 eval font create mainfont [fontflags mainfont]
11069 eval font create mainfontbold [fontflags mainfont 1]
11070
11071 parsefont textfont $textfont
11072 eval font create textfont [fontflags textfont]
11073 eval font create textfontbold [fontflags textfont 1]
11074
11075 parsefont uifont $uifont
11076 eval font create uifont [fontflags uifont]
11077
11078 setoptions
11079
11080 # check that we can find a .git directory somewhere...
11081 if {[catch {set gitdir [gitdir]}]} {
11082     show_error {} . [mc "Cannot find a git repository here."]
11083     exit 1
11084 }
11085 if {![file isdirectory $gitdir]} {
11086     show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
11087     exit 1
11088 }
11089
11090 set selecthead {}
11091 set selectheadid {}
11092
11093 set revtreeargs {}
11094 set cmdline_files {}
11095 set i 0
11096 set revtreeargscmd {}
11097 foreach arg $argv {
11098     switch -glob -- $arg {
11099         "" { }
11100         "--" {
11101             set cmdline_files [lrange $argv [expr {$i + 1}] end]
11102             break
11103         }
11104         "--select-commit=*" {
11105             set selecthead [string range $arg 16 end]
11106         }
11107         "--argscmd=*" {
11108             set revtreeargscmd [string range $arg 10 end]
11109         }
11110         default {
11111             lappend revtreeargs $arg
11112         }
11113     }
11114     incr i
11115 }
11116
11117 if {$selecthead eq "HEAD"} {
11118     set selecthead {}
11119 }
11120
11121 if {$i >= [llength $argv] && $revtreeargs ne {}} {
11122     # no -- on command line, but some arguments (other than --argscmd)
11123     if {[catch {
11124         set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
11125         set cmdline_files [split $f "\n"]
11126         set n [llength $cmdline_files]
11127         set revtreeargs [lrange $revtreeargs 0 end-$n]
11128         # Unfortunately git rev-parse doesn't produce an error when
11129         # something is both a revision and a filename.  To be consistent
11130         # with git log and git rev-list, check revtreeargs for filenames.
11131         foreach arg $revtreeargs {
11132             if {[file exists $arg]} {
11133                 show_error {} . [mc "Ambiguous argument '%s': both revision\
11134                                  and filename" $arg]
11135                 exit 1
11136             }
11137         }
11138     } err]} {
11139         # unfortunately we get both stdout and stderr in $err,
11140         # so look for "fatal:".
11141         set i [string first "fatal:" $err]
11142         if {$i > 0} {
11143             set err [string range $err [expr {$i + 6}] end]
11144         }
11145         show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
11146         exit 1
11147     }
11148 }
11149
11150 set nullid "0000000000000000000000000000000000000000"
11151 set nullid2 "0000000000000000000000000000000000000001"
11152 set nullfile "/dev/null"
11153
11154 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
11155 set git_version [lindex [exec git version] end]
11156
11157 set runq {}
11158 set history {}
11159 set historyindex 0
11160 set fh_serial 0
11161 set nhl_names {}
11162 set highlight_paths {}
11163 set findpattern {}
11164 set searchdirn -forwards
11165 set boldids {}
11166 set boldnameids {}
11167 set diffelide {0 0}
11168 set markingmatches 0
11169 set linkentercount 0
11170 set need_redisplay 0
11171 set nrows_drawn 0
11172 set firsttabstop 0
11173
11174 set nextviewnum 1
11175 set curview 0
11176 set selectedview 0
11177 set selectedhlview [mc "None"]
11178 set highlight_related [mc "None"]
11179 set highlight_files {}
11180 set viewfiles(0) {}
11181 set viewperm(0) 0
11182 set viewargs(0) {}
11183 set viewargscmd(0) {}
11184
11185 set selectedline {}
11186 set numcommits 0
11187 set loginstance 0
11188 set cmdlineok 0
11189 set stopped 0
11190 set stuffsaved 0
11191 set patchnum 0
11192 set lserial 0
11193 set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
11194 setcoords
11195 makewindow
11196 catch {
11197     image create photo gitlogo      -width 16 -height 16
11198
11199     image create photo gitlogominus -width  4 -height  2
11200     gitlogominus put #C00000 -to 0 0 4 2
11201     gitlogo copy gitlogominus -to  1 5
11202     gitlogo copy gitlogominus -to  6 5
11203     gitlogo copy gitlogominus -to 11 5
11204     image delete gitlogominus
11205
11206     image create photo gitlogoplus  -width  4 -height  4
11207     gitlogoplus  put #008000 -to 1 0 3 4
11208     gitlogoplus  put #008000 -to 0 1 4 3
11209     gitlogo copy gitlogoplus  -to  1 9
11210     gitlogo copy gitlogoplus  -to  6 9
11211     gitlogo copy gitlogoplus  -to 11 9
11212     image delete gitlogoplus
11213
11214     image create photo gitlogo32    -width 32 -height 32
11215     gitlogo32 copy gitlogo -zoom 2 2
11216
11217     wm iconphoto . -default gitlogo gitlogo32
11218 }
11219 # wait for the window to become visible
11220 tkwait visibility .
11221 wm title . "[file tail $argv0]: [file tail [pwd]]"
11222 update
11223 readrefs
11224
11225 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
11226     # create a view for the files/dirs specified on the command line
11227     set curview 1
11228     set selectedview 1
11229     set nextviewnum 2
11230     set viewname(1) [mc "Command line"]
11231     set viewfiles(1) $cmdline_files
11232     set viewargs(1) $revtreeargs
11233     set viewargscmd(1) $revtreeargscmd
11234     set viewperm(1) 0
11235     set vdatemode(1) 0
11236     addviewmenu 1
11237     .bar.view entryconf [mca "Edit view..."] -state normal
11238     .bar.view entryconf [mca "Delete view"] -state normal
11239 }
11240
11241 if {[info exists permviews]} {
11242     foreach v $permviews {
11243         set n $nextviewnum
11244         incr nextviewnum
11245         set viewname($n) [lindex $v 0]
11246         set viewfiles($n) [lindex $v 1]
11247         set viewargs($n) [lindex $v 2]
11248         set viewargscmd($n) [lindex $v 3]
11249         set viewperm($n) 1
11250         addviewmenu $n
11251     }
11252 }
11253
11254 if {[tk windowingsystem] eq "win32"} {
11255     focus -force .
11256 }
11257
11258 getcommits {}