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