gitk-git/gitk

   1 #!/bin/sh
   2 # Tcl ignores the next line -*- tcl -*- \
   3 exec wish "$0" -- "$@"
   4
   5 # Copyright (C) 2005-2006 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
  26
  27     set script $args
  28     if {[info exists isonrunq($script)]} return
  29     if {$runq eq {}} {
  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
  42
  43     fileevent $fd readable {}
  44     if {$runq eq {}} {
  45         after idle dorunq
  46     }
  47     lappend runq [list $fd $script]
  48 }
  49
  50 proc dorunq {} {
  51     global isonrunq runq
  52
  53     set tstart [clock clicks -milliseconds]
  54     set t0 $tstart
  55     while {$runq ne {}} {
  56         set fd [lindex $runq 0 0]
  57         set script [lindex $runq 0 1]
  58         set repeat [eval $script]
  59         set t1 [clock clicks -milliseconds]
  60         set t [expr {$t1 - $t0}]
  61         set runq [lrange $runq 1 end]
  62         if {$repeat ne {} && $repeat} {
  63             if {$fd eq {} || $repeat == 2} {
  64                 # script returns 1 if it wants to be readded
  65                 # file readers return 2 if they could do more straight away
  66                 lappend runq [list $fd $script]
  67             } else {
  68                 fileevent $fd readable [list filereadable $fd $script]
  69             }
  70         } elseif {$fd eq {}} {
  71             unset isonrunq($script)
  72         }
  73         set t0 $t1
  74         if {$t1 - $tstart >= 80} break
  75     }
  76     if {$runq ne {}} {
  77         after idle dorunq
  78     }
  79 }
  80
  81 # Start off a git rev-list process and arrange to read its output
  82 proc start_rev_list {view} {
  83     global startmsecs
  84     global commfd leftover tclencoding datemode
  85     global viewargs viewfiles commitidx viewcomplete vnextroot
  86     global showlocalchanges commitinterest mainheadid
  87     global progressdirn progresscoords proglastnc curview
  88
  89     set startmsecs [clock clicks -milliseconds]
  90     set commitidx($view) 0
  91     set viewcomplete($view) 0
  92     set vnextroot($view) 0
  93     set order "--topo-order"
  94     if {$datemode} {
  95         set order "--date-order"
  96     }
  97     if {[catch {
  98         set fd [open [concat | git log --no-color -z --pretty=raw $order --parents \
  99                          --boundary $viewargs($view) "--" $viewfiles($view)] r]
 100     } err]} {
 101         error_popup "[mc "Error executing git rev-list:"] $err"
 102         exit 1
 103     }
 104     set commfd($view) $fd
 105     set leftover($view) {}
 106     if {$showlocalchanges} {
 107         lappend commitinterest($mainheadid) {dodiffindex}
 108     }
 109     fconfigure $fd -blocking 0 -translation lf -eofchar {}
 110     if {$tclencoding != {}} {
 111         fconfigure $fd -encoding $tclencoding
 112     }
 113     filerun $fd [list getcommitlines $fd $view]
 114     nowbusy $view [mc "Reading"]
 115     if {$view == $curview} {
 116         set progressdirn 1
 117         set progresscoords {0 0}
 118         set proglastnc 0
 119     }
 120 }
 121
 122 proc stop_rev_list {} {
 123     global commfd curview
 124
 125     if {![info exists commfd($curview)]} return
 126     set fd $commfd($curview)
 127     catch {
 128         set pid [pid $fd]
 129         exec kill $pid
 130     }
 131     catch {close $fd}
 132     unset commfd($curview)
 133 }
 134
 135 proc getcommits {} {
 136     global phase canv curview
 137
 138     set phase getcommits
 139     initlayout
 140     start_rev_list $curview
 141     show_status [mc "Reading commits..."]
 142 }
 143
 144 # This makes a string representation of a positive integer which
 145 # sorts as a string in numerical order
 146 proc strrep {n} {
 147     if {$n < 16} {
 148         return [format "%x" $n]
 149     } elseif {$n < 256} {
 150         return [format "x%.2x" $n]
 151     } elseif {$n < 65536} {
 152         return [format "y%.4x" $n]
 153     }
 154     return [format "z%.8x" $n]
 155 }
 156
 157 proc getcommitlines {fd view}  {
 158     global commitlisted commitinterest
 159     global leftover commfd
 160     global displayorder commitidx viewcomplete commitrow commitdata
 161     global parentlist children curview hlview
 162     global vparentlist vdisporder vcmitlisted
 163     global ordertok vnextroot idpending
 164
 165     set stuff [read $fd 500000]
 166     # git log doesn't terminate the last commit with a null...
 167     if {$stuff == {} && $leftover($view) ne {} && [eof $fd]} {
 168         set stuff "\0"
 169     }
 170     if {$stuff == {}} {
 171         if {![eof $fd]} {
 172             return 1
 173         }
 174         # Check if we have seen any ids listed as parents that haven't
 175         # appeared in the list
 176         foreach vid [array names idpending "$view,*"] {
 177             # should only get here if git log is buggy
 178             set id [lindex [split $vid ","] 1]
 179             set commitrow($vid) $commitidx($view)
 180             incr commitidx($view)
 181             if {$view == $curview} {
 182                 lappend parentlist {}
 183                 lappend displayorder $id
 184                 lappend commitlisted 0
 185             } else {
 186                 lappend vparentlist($view) {}
 187                 lappend vdisporder($view) $id
 188                 lappend vcmitlisted($view) 0
 189             }
 190         }
 191         set viewcomplete($view) 1
 192         global viewname progresscoords
 193         unset commfd($view)
 194         notbusy $view
 195         set progresscoords {0 0}
 196         adjustprogress
 197         # set it blocking so we wait for the process to terminate
 198         fconfigure $fd -blocking 1
 199         if {[catch {close $fd} err]} {
 200             set fv {}
 201             if {$view != $curview} {
 202                 set fv " for the \"$viewname($view)\" view"
 203             }
 204             if {[string range $err 0 4] == "usage"} {
 205                 set err "Gitk: error reading commits$fv:\
 206                         bad arguments to git rev-list."
 207                 if {$viewname($view) eq "Command line"} {
 208                     append err \
 209                         "  (Note: arguments to gitk are passed to git rev-list\
 210                          to allow selection of commits to be displayed.)"
 211                 }
 212             } else {
 213                 set err "Error reading commits$fv: $err"
 214             }
 215             error_popup $err
 216         }
 217         if {$view == $curview} {
 218             run chewcommits $view
 219         }
 220         return 0
 221     }
 222     set start 0
 223     set gotsome 0
 224     while 1 {
 225         set i [string first "\0" $stuff $start]
 226         if {$i < 0} {
 227             append leftover($view) [string range $stuff $start end]
 228             break
 229         }
 230         if {$start == 0} {
 231             set cmit $leftover($view)
 232             append cmit [string range $stuff 0 [expr {$i - 1}]]
 233             set leftover($view) {}
 234         } else {
 235             set cmit [string range $stuff $start [expr {$i - 1}]]
 236         }
 237         set start [expr {$i + 1}]
 238         set j [string first "\n" $cmit]
 239         set ok 0
 240         set listed 1
 241         if {$j >= 0 && [string match "commit *" $cmit]} {
 242             set ids [string range $cmit 7 [expr {$j - 1}]]
 243             if {[string match {[-^<>]*} $ids]} {
 244                 switch -- [string index $ids 0] {
 245                     "-" {set listed 0}
 246                     "^" {set listed 2}
 247                     "<" {set listed 3}
 248                     ">" {set listed 4}
 249                 }
 250                 set ids [string range $ids 1 end]
 251             }
 252             set ok 1
 253             foreach id $ids {
 254                 if {[string length $id] != 40} {
 255                     set ok 0
 256                     break
 257                 }
 258             }
 259         }
 260         if {!$ok} {
 261             set shortcmit $cmit
 262             if {[string length $shortcmit] > 80} {
 263                 set shortcmit "[string range $shortcmit 0 80]..."
 264             }
 265             error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
 266             exit 1
 267         }
 268         set id [lindex $ids 0]
 269         if {![info exists ordertok($view,$id)]} {
 270             set otok "o[strrep $vnextroot($view)]"
 271             incr vnextroot($view)
 272             set ordertok($view,$id) $otok
 273         } else {
 274             set otok $ordertok($view,$id)
 275             unset idpending($view,$id)
 276         }
 277         if {$listed} {
 278             set olds [lrange $ids 1 end]
 279             if {[llength $olds] == 1} {
 280                 set p [lindex $olds 0]
 281                 lappend children($view,$p) $id
 282                 if {![info exists ordertok($view,$p)]} {
 283                     set ordertok($view,$p) $ordertok($view,$id)
 284                     set idpending($view,$p) 1
 285                 }
 286             } else {
 287                 set i 0
 288                 foreach p $olds {
 289                     if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
 290                         lappend children($view,$p) $id
 291                     }
 292                     if {![info exists ordertok($view,$p)]} {
 293                         set ordertok($view,$p) "$otok[strrep $i]]"
 294                         set idpending($view,$p) 1
 295                     }
 296                     incr i
 297                 }
 298             }
 299         } else {
 300             set olds {}
 301         }
 302         if {![info exists children($view,$id)]} {
 303             set children($view,$id) {}
 304         }
 305         set commitdata($id) [string range $cmit [expr {$j + 1}] end]
 306         set commitrow($view,$id) $commitidx($view)
 307         incr commitidx($view)
 308         if {$view == $curview} {
 309             lappend parentlist $olds
 310             lappend displayorder $id
 311             lappend commitlisted $listed
 312         } else {
 313             lappend vparentlist($view) $olds
 314             lappend vdisporder($view) $id
 315             lappend vcmitlisted($view) $listed
 316         }
 317         if {[info exists commitinterest($id)]} {
 318             foreach script $commitinterest($id) {
 319                 eval [string map [list "%I" $id] $script]
 320             }
 321             unset commitinterest($id)
 322         }
 323         set gotsome 1
 324     }
 325     if {$gotsome} {
 326         run chewcommits $view
 327         if {$view == $curview} {
 328             # update progress bar
 329             global progressdirn progresscoords proglastnc
 330             set inc [expr {($commitidx($view) - $proglastnc) * 0.0002}]
 331             set proglastnc $commitidx($view)
 332             set l [lindex $progresscoords 0]
 333             set r [lindex $progresscoords 1]
 334             if {$progressdirn} {
 335                 set r [expr {$r + $inc}]
 336                 if {$r >= 1.0} {
 337                     set r 1.0
 338                     set progressdirn 0
 339                 }
 340                 if {$r > 0.2} {
 341                     set l [expr {$r - 0.2}]
 342                 }
 343             } else {
 344                 set l [expr {$l - $inc}]
 345                 if {$l <= 0.0} {
 346                     set l 0.0
 347                     set progressdirn 1
 348                 }
 349                 set r [expr {$l + 0.2}]
 350             }
 351             set progresscoords [list $l $r]
 352             adjustprogress
 353         }
 354     }
 355     return 2
 356 }
 357
 358 proc chewcommits {view} {
 359     global curview hlview viewcomplete
 360     global selectedline pending_select
 361
 362     if {$view == $curview} {
 363         layoutmore
 364         if {$viewcomplete($view)} {
 365             global displayorder commitidx phase
 366             global numcommits startmsecs
 367
 368             if {[info exists pending_select]} {
 369                 set row [first_real_row]
 370                 selectline $row 1
 371             }
 372             if {$commitidx($curview) > 0} {
 373                 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
 374                 #puts "overall $ms ms for $numcommits commits"
 375             } else {
 376                 show_status [mc "No commits selected"]
 377             }
 378             notbusy layout
 379             set phase {}
 380         }
 381     }
 382     if {[info exists hlview] && $view == $hlview} {
 383         vhighlightmore
 384     }
 385     return 0
 386 }
 387
 388 proc readcommit {id} {
 389     if {[catch {set contents [exec git cat-file commit $id]}]} return
 390     parsecommit $id $contents 0
 391 }
 392
 393 proc updatecommits {} {
 394     global viewdata curview phase displayorder ordertok idpending
 395     global children commitrow selectedline thickerline showneartags
 396
 397     if {$phase ne {}} {
 398         stop_rev_list
 399         set phase {}
 400     }
 401     set n $curview
 402     foreach id $displayorder {
 403         catch {unset children($n,$id)}
 404         catch {unset commitrow($n,$id)}
 405         catch {unset ordertok($n,$id)}
 406     }
 407     foreach vid [array names idpending "$n,*"] {
 408         unset idpending($vid)
 409     }
 410     set curview -1
 411     catch {unset selectedline}
 412     catch {unset thickerline}
 413     catch {unset viewdata($n)}
 414     readrefs
 415     changedrefs
 416     if {$showneartags} {
 417         getallcommits
 418     }
 419     showview $n
 420 }
 421
 422 proc parsecommit {id contents listed} {
 423     global commitinfo cdate
 424
 425     set inhdr 1
 426     set comment {}
 427     set headline {}
 428     set auname {}
 429     set audate {}
 430     set comname {}
 431     set comdate {}
 432     set hdrend [string first "\n\n" $contents]
 433     if {$hdrend < 0} {
 434         # should never happen...
 435         set hdrend [string length $contents]
 436     }
 437     set header [string range $contents 0 [expr {$hdrend - 1}]]
 438     set comment [string range $contents [expr {$hdrend + 2}] end]
 439     foreach line [split $header "\n"] {
 440         set tag [lindex $line 0]
 441         if {$tag == "author"} {
 442             set audate [lindex $line end-1]
 443             set auname [lrange $line 1 end-2]
 444         } elseif {$tag == "committer"} {
 445             set comdate [lindex $line end-1]
 446             set comname [lrange $line 1 end-2]
 447         }
 448     }
 449     set headline {}
 450     # take the first non-blank line of the comment as the headline
 451     set headline [string trimleft $comment]
 452     set i [string first "\n" $headline]
 453     if {$i >= 0} {
 454         set headline [string range $headline 0 $i]
 455     }
 456     set headline [string trimright $headline]
 457     set i [string first "\r" $headline]
 458     if {$i >= 0} {
 459         set headline [string trimright [string range $headline 0 $i]]
 460     }
 461     if {!$listed} {
 462         # git rev-list indents the comment by 4 spaces;
 463         # if we got this via git cat-file, add the indentation
 464         set newcomment {}
 465         foreach line [split $comment "\n"] {
 466             append newcomment "    "
 467             append newcomment $line
 468             append newcomment "\n"
 469         }
 470         set comment $newcomment
 471     }
 472     if {$comdate != {}} {
 473         set cdate($id) $comdate
 474     }
 475     set commitinfo($id) [list $headline $auname $audate \
 476                              $comname $comdate $comment]
 477 }
 478
 479 proc getcommit {id} {
 480     global commitdata commitinfo
 481
 482     if {[info exists commitdata($id)]} {
 483         parsecommit $id $commitdata($id) 1
 484     } else {
 485         readcommit $id
 486         if {![info exists commitinfo($id)]} {
 487             set commitinfo($id) [list [mc "No commit information available"]]
 488         }
 489     }
 490     return 1
 491 }
 492
 493 proc readrefs {} {
 494     global tagids idtags headids idheads tagobjid
 495     global otherrefids idotherrefs mainhead mainheadid
 496
 497     foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
 498         catch {unset $v}
 499     }
 500     set refd [open [list | git show-ref -d] r]
 501     while {[gets $refd line] >= 0} {
 502         if {[string index $line 40] ne " "} continue
 503         set id [string range $line 0 39]
 504         set ref [string range $line 41 end]
 505         if {![string match "refs/*" $ref]} continue
 506         set name [string range $ref 5 end]
 507         if {[string match "remotes/*" $name]} {
 508             if {![string match "*/HEAD" $name]} {
 509                 set headids($name) $id
 510                 lappend idheads($id) $name
 511             }
 512         } elseif {[string match "heads/*" $name]} {
 513             set name [string range $name 6 end]
 514             set headids($name) $id
 515             lappend idheads($id) $name
 516         } elseif {[string match "tags/*" $name]} {
 517             # this lets refs/tags/foo^{} overwrite refs/tags/foo,
 518             # which is what we want since the former is the commit ID
 519             set name [string range $name 5 end]
 520             if {[string match "*^{}" $name]} {
 521                 set name [string range $name 0 end-3]
 522             } else {
 523                 set tagobjid($name) $id
 524             }
 525             set tagids($name) $id
 526             lappend idtags($id) $name
 527         } else {
 528             set otherrefids($name) $id
 529             lappend idotherrefs($id) $name
 530         }
 531     }
 532     catch {close $refd}
 533     set mainhead {}
 534     set mainheadid {}
 535     catch {
 536         set thehead [exec git symbolic-ref HEAD]
 537         if {[string match "refs/heads/*" $thehead]} {
 538             set mainhead [string range $thehead 11 end]
 539             if {[info exists headids($mainhead)]} {
 540                 set mainheadid $headids($mainhead)
 541             }
 542         }
 543     }
 544 }
 545
 546 # skip over fake commits
 547 proc first_real_row {} {
 548     global nullid nullid2 displayorder numcommits
 549
 550     for {set row 0} {$row < $numcommits} {incr row} {
 551         set id [lindex $displayorder $row]
 552         if {$id ne $nullid && $id ne $nullid2} {
 553             break
 554         }
 555     }
 556     return $row
 557 }
 558
 559 # update things for a head moved to a child of its previous location
 560 proc movehead {id name} {
 561     global headids idheads
 562
 563     removehead $headids($name) $name
 564     set headids($name) $id
 565     lappend idheads($id) $name
 566 }
 567
 568 # update things when a head has been removed
 569 proc removehead {id name} {
 570     global headids idheads
 571
 572     if {$idheads($id) eq $name} {
 573         unset idheads($id)
 574     } else {
 575         set i [lsearch -exact $idheads($id) $name]
 576         if {$i >= 0} {
 577             set idheads($id) [lreplace $idheads($id) $i $i]
 578         }
 579     }
 580     unset headids($name)
 581 }
 582
 583 proc show_error {w top msg} {
 584     message $w.m -text $msg -justify center -aspect 400
 585     pack $w.m -side top -fill x -padx 20 -pady 20
 586     button $w.ok -text [mc OK] -command "destroy $top"
 587     pack $w.ok -side bottom -fill x
 588     bind $top <Visibility> "grab $top; focus $top"
 589     bind $top <Key-Return> "destroy $top"
 590     tkwait window $top
 591 }
 592
 593 proc error_popup msg {
 594     set w .error
 595     toplevel $w
 596     wm transient $w .
 597     show_error $w $w $msg
 598 }
 599
 600 proc confirm_popup msg {
 601     global confirm_ok
 602     set confirm_ok 0
 603     set w .confirm
 604     toplevel $w
 605     wm transient $w .
 606     message $w.m -text $msg -justify center -aspect 400
 607     pack $w.m -side top -fill x -padx 20 -pady 20
 608     button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
 609     pack $w.ok -side left -fill x
 610     button $w.cancel -text [mc Cancel] -command "destroy $w"
 611     pack $w.cancel -side right -fill x
 612     bind $w <Visibility> "grab $w; focus $w"
 613     tkwait window $w
 614     return $confirm_ok
 615 }
 616
 617 proc setoptions {} {
 618     option add *Panedwindow.showHandle 1 startupFile
 619     option add *Panedwindow.sashRelief raised startupFile
 620     option add *Button.font uifont startupFile
 621     option add *Checkbutton.font uifont startupFile
 622     option add *Radiobutton.font uifont startupFile
 623     option add *Menu.font uifont startupFile
 624     option add *Menubutton.font uifont startupFile
 625     option add *Label.font uifont startupFile
 626     option add *Message.font uifont startupFile
 627     option add *Entry.font uifont startupFile
 628 }
 629
 630 proc makewindow {} {
 631     global canv canv2 canv3 linespc charspc ctext cflist
 632     global tabstop
 633     global findtype findtypemenu findloc findstring fstring geometry
 634     global entries sha1entry sha1string sha1but
 635     global diffcontextstring diffcontext
 636     global ignorespace
 637     global maincursor textcursor curtextcursor
 638     global rowctxmenu fakerowmenu mergemax wrapcomment
 639     global highlight_files gdttype
 640     global searchstring sstring
 641     global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
 642     global headctxmenu progresscanv progressitem progresscoords statusw
 643     global fprogitem fprogcoord lastprogupdate progupdatepending
 644     global rprogitem rprogcoord
 645     global have_tk85
 646
 647     menu .bar
 648     .bar add cascade -label [mc "File"] -menu .bar.file
 649     menu .bar.file
 650     .bar.file add command -label [mc "Update"] -command updatecommits
 651     .bar.file add command -label [mc "Reread references"] -command rereadrefs
 652     .bar.file add command -label [mc "List references"] -command showrefs
 653     .bar.file add command -label [mc "Quit"] -command doquit
 654     menu .bar.edit
 655     .bar add cascade -label [mc "Edit"] -menu .bar.edit
 656     .bar.edit add command -label [mc "Preferences"] -command doprefs
 657
 658     menu .bar.view
 659     .bar add cascade -label [mc "View"] -menu .bar.view
 660     .bar.view add command -label [mc "New view..."] -command {newview 0}
 661     .bar.view add command -label [mc "Edit view..."] -command editview \
 662         -state disabled
 663     .bar.view add command -label [mc "Delete view"] -command delview -state disabled
 664     .bar.view add separator
 665     .bar.view add radiobutton -label [mc "All files"] -command {showview 0} \
 666         -variable selectedview -value 0
 667
 668     menu .bar.help
 669     .bar add cascade -label [mc "Help"] -menu .bar.help
 670     .bar.help add command -label [mc "About gitk"] -command about
 671     .bar.help add command -label [mc "Key bindings"] -command keys
 672     .bar.help configure
 673     . configure -menu .bar
 674
 675     # the gui has upper and lower half, parts of a paned window.
 676     panedwindow .ctop -orient vertical
 677
 678     # possibly use assumed geometry
 679     if {![info exists geometry(pwsash0)]} {
 680         set geometry(topheight) [expr {15 * $linespc}]
 681         set geometry(topwidth) [expr {80 * $charspc}]
 682         set geometry(botheight) [expr {15 * $linespc}]
 683         set geometry(botwidth) [expr {50 * $charspc}]
 684         set geometry(pwsash0) "[expr {40 * $charspc}] 2"
 685         set geometry(pwsash1) "[expr {60 * $charspc}] 2"
 686     }
 687
 688     # the upper half will have a paned window, a scroll bar to the right, and some stuff below
 689     frame .tf -height $geometry(topheight) -width $geometry(topwidth)
 690     frame .tf.histframe
 691     panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
 692
 693     # create three canvases
 694     set cscroll .tf.histframe.csb
 695     set canv .tf.histframe.pwclist.canv
 696     canvas $canv \
 697         -selectbackground $selectbgcolor \
 698         -background $bgcolor -bd 0 \
 699         -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
 700     .tf.histframe.pwclist add $canv
 701     set canv2 .tf.histframe.pwclist.canv2
 702     canvas $canv2 \
 703         -selectbackground $selectbgcolor \
 704         -background $bgcolor -bd 0 -yscrollincr $linespc
 705     .tf.histframe.pwclist add $canv2
 706     set canv3 .tf.histframe.pwclist.canv3
 707     canvas $canv3 \
 708         -selectbackground $selectbgcolor \
 709         -background $bgcolor -bd 0 -yscrollincr $linespc
 710     .tf.histframe.pwclist add $canv3
 711     eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
 712     eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
 713
 714     # a scroll bar to rule them
 715     scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
 716     pack $cscroll -side right -fill y
 717     bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
 718     lappend bglist $canv $canv2 $canv3
 719     pack .tf.histframe.pwclist -fill both -expand 1 -side left
 720
 721     # we have two button bars at bottom of top frame. Bar 1
 722     frame .tf.bar
 723     frame .tf.lbar -height 15
 724
 725     set sha1entry .tf.bar.sha1
 726     set entries $sha1entry
 727     set sha1but .tf.bar.sha1label
 728     button $sha1but -text [mc "SHA1 ID: "] -state disabled -relief flat \
 729         -command gotocommit -width 8
 730     $sha1but conf -disabledforeground [$sha1but cget -foreground]
 731     pack .tf.bar.sha1label -side left
 732     entry $sha1entry -width 40 -font textfont -textvariable sha1string
 733     trace add variable sha1string write sha1change
 734     pack $sha1entry -side left -pady 2
 735
 736     image create bitmap bm-left -data {
 737         #define left_width 16
 738         #define left_height 16
 739         static unsigned char left_bits[] = {
 740         0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
 741         0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
 742         0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
 743     }
 744     image create bitmap bm-right -data {
 745         #define right_width 16
 746         #define right_height 16
 747         static unsigned char right_bits[] = {
 748         0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
 749         0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
 750         0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
 751     }
 752     button .tf.bar.leftbut -image bm-left -command goback \
 753         -state disabled -width 26
 754     pack .tf.bar.leftbut -side left -fill y
 755     button .tf.bar.rightbut -image bm-right -command goforw \
 756         -state disabled -width 26
 757     pack .tf.bar.rightbut -side left -fill y
 758
 759     # Status label and progress bar
 760     set statusw .tf.bar.status
 761     label $statusw -width 15 -relief sunken
 762     pack $statusw -side left -padx 5
 763     set h [expr {[font metrics uifont -linespace] + 2}]
 764     set progresscanv .tf.bar.progress
 765     canvas $progresscanv -relief sunken -height $h -borderwidth 2
 766     set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
 767     set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
 768     set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
 769     pack $progresscanv -side right -expand 1 -fill x
 770     set progresscoords {0 0}
 771     set fprogcoord 0
 772     set rprogcoord 0
 773     bind $progresscanv <Configure> adjustprogress
 774     set lastprogupdate [clock clicks -milliseconds]
 775     set progupdatepending 0
 776
 777     # build up the bottom bar of upper window
 778     label .tf.lbar.flabel -text "[mc "Find"] "
 779     button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
 780     button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
 781     label .tf.lbar.flab2 -text " [mc "commit"] "
 782     pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
 783         -side left -fill y
 784     set gdttype [mc "containing:"]
 785     set gm [tk_optionMenu .tf.lbar.gdttype gdttype \
 786                 [mc "containing:"] \
 787                 [mc "touching paths:"] \
 788                 [mc "adding/removing string:"]]
 789     trace add variable gdttype write gdttype_change
 790     pack .tf.lbar.gdttype -side left -fill y
 791
 792     set findstring {}
 793     set fstring .tf.lbar.findstring
 794     lappend entries $fstring
 795     entry $fstring -width 30 -font textfont -textvariable findstring
 796     trace add variable findstring write find_change
 797     set findtype [mc "Exact"]
 798     set findtypemenu [tk_optionMenu .tf.lbar.findtype \
 799                       findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
 800     trace add variable findtype write findcom_change
 801     set findloc [mc "All fields"]
 802     tk_optionMenu .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
 803         [mc "Comments"] [mc "Author"] [mc "Committer"]
 804     trace add variable findloc write find_change
 805     pack .tf.lbar.findloc -side right
 806     pack .tf.lbar.findtype -side right
 807     pack $fstring -side left -expand 1 -fill x
 808
 809     # Finish putting the upper half of the viewer together
 810     pack .tf.lbar -in .tf -side bottom -fill x
 811     pack .tf.bar -in .tf -side bottom -fill x
 812     pack .tf.histframe -fill both -side top -expand 1
 813     .ctop add .tf
 814     .ctop paneconfigure .tf -height $geometry(topheight)
 815     .ctop paneconfigure .tf -width $geometry(topwidth)
 816
 817     # now build up the bottom
 818     panedwindow .pwbottom -orient horizontal
 819
 820     # lower left, a text box over search bar, scroll bar to the right
 821     # if we know window height, then that will set the lower text height, otherwise
 822     # we set lower text height which will drive window height
 823     if {[info exists geometry(main)]} {
 824         frame .bleft -width $geometry(botwidth)
 825     } else {
 826         frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
 827     }
 828     frame .bleft.top
 829     frame .bleft.mid
 830
 831     button .bleft.top.search -text [mc "Search"] -command dosearch
 832     pack .bleft.top.search -side left -padx 5
 833     set sstring .bleft.top.sstring
 834     entry $sstring -width 20 -font textfont -textvariable searchstring
 835     lappend entries $sstring
 836     trace add variable searchstring write incrsearch
 837     pack $sstring -side left -expand 1 -fill x
 838     radiobutton .bleft.mid.diff -text [mc "Diff"] \
 839         -command changediffdisp -variable diffelide -value {0 0}
 840     radiobutton .bleft.mid.old -text [mc "Old version"] \
 841         -command changediffdisp -variable diffelide -value {0 1}
 842     radiobutton .bleft.mid.new -text [mc "New version"] \
 843         -command changediffdisp -variable diffelide -value {1 0}
 844     label .bleft.mid.labeldiffcontext -text "      [mc "Lines of context"]: "
 845     pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
 846     spinbox .bleft.mid.diffcontext -width 5 -font textfont \
 847         -from 1 -increment 1 -to 10000000 \
 848         -validate all -validatecommand "diffcontextvalidate %P" \
 849         -textvariable diffcontextstring
 850     .bleft.mid.diffcontext set $diffcontext
 851     trace add variable diffcontextstring write diffcontextchange
 852     lappend entries .bleft.mid.diffcontext
 853     pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
 854     checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
 855         -command changeignorespace -variable ignorespace
 856     pack .bleft.mid.ignspace -side left -padx 5
 857     set ctext .bleft.ctext
 858     text $ctext -background $bgcolor -foreground $fgcolor \
 859         -state disabled -font textfont \
 860         -yscrollcommand scrolltext -wrap none
 861     if {$have_tk85} {
 862         $ctext conf -tabstyle wordprocessor
 863     }
 864     scrollbar .bleft.sb -command "$ctext yview"
 865     pack .bleft.top -side top -fill x
 866     pack .bleft.mid -side top -fill x
 867     pack .bleft.sb -side right -fill y
 868     pack $ctext -side left -fill both -expand 1
 869     lappend bglist $ctext
 870     lappend fglist $ctext
 871
 872     $ctext tag conf comment -wrap $wrapcomment
 873     $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
 874     $ctext tag conf hunksep -fore [lindex $diffcolors 2]
 875     $ctext tag conf d0 -fore [lindex $diffcolors 0]
 876     $ctext tag conf d1 -fore [lindex $diffcolors 1]
 877     $ctext tag conf m0 -fore red
 878     $ctext tag conf m1 -fore blue
 879     $ctext tag conf m2 -fore green
 880     $ctext tag conf m3 -fore purple
 881     $ctext tag conf m4 -fore brown
 882     $ctext tag conf m5 -fore "#009090"
 883     $ctext tag conf m6 -fore magenta
 884     $ctext tag conf m7 -fore "#808000"
 885     $ctext tag conf m8 -fore "#009000"
 886     $ctext tag conf m9 -fore "#ff0080"
 887     $ctext tag conf m10 -fore cyan
 888     $ctext tag conf m11 -fore "#b07070"
 889     $ctext tag conf m12 -fore "#70b0f0"
 890     $ctext tag conf m13 -fore "#70f0b0"
 891     $ctext tag conf m14 -fore "#f0b070"
 892     $ctext tag conf m15 -fore "#ff70b0"
 893     $ctext tag conf mmax -fore darkgrey
 894     set mergemax 16
 895     $ctext tag conf mresult -font textfontbold
 896     $ctext tag conf msep -font textfontbold
 897     $ctext tag conf found -back yellow
 898
 899     .pwbottom add .bleft
 900     .pwbottom paneconfigure .bleft -width $geometry(botwidth)
 901
 902     # lower right
 903     frame .bright
 904     frame .bright.mode
 905     radiobutton .bright.mode.patch -text [mc "Patch"] \
 906         -command reselectline -variable cmitmode -value "patch"
 907     radiobutton .bright.mode.tree -text [mc "Tree"] \
 908         -command reselectline -variable cmitmode -value "tree"
 909     grid .bright.mode.patch .bright.mode.tree -sticky ew
 910     pack .bright.mode -side top -fill x
 911     set cflist .bright.cfiles
 912     set indent [font measure mainfont "nn"]
 913     text $cflist \
 914         -selectbackground $selectbgcolor \
 915         -background $bgcolor -foreground $fgcolor \
 916         -font mainfont \
 917         -tabs [list $indent [expr {2 * $indent}]] \
 918         -yscrollcommand ".bright.sb set" \
 919         -cursor [. cget -cursor] \
 920         -spacing1 1 -spacing3 1
 921     lappend bglist $cflist
 922     lappend fglist $cflist
 923     scrollbar .bright.sb -command "$cflist yview"
 924     pack .bright.sb -side right -fill y
 925     pack $cflist -side left -fill both -expand 1
 926     $cflist tag configure highlight \
 927         -background [$cflist cget -selectbackground]
 928     $cflist tag configure bold -font mainfontbold
 929
 930     .pwbottom add .bright
 931     .ctop add .pwbottom
 932
 933     # restore window position if known
 934     if {[info exists geometry(main)]} {
 935         wm geometry . "$geometry(main)"
 936     }
 937
 938     if {[tk windowingsystem] eq {aqua}} {
 939         set M1B M1
 940     } else {
 941         set M1B Control
 942     }
 943
 944     bind .pwbottom <Configure> {resizecdetpanes %W %w}
 945     pack .ctop -fill both -expand 1
 946     bindall <1> {selcanvline %W %x %y}
 947     #bindall <B1-Motion> {selcanvline %W %x %y}
 948     if {[tk windowingsystem] == "win32"} {
 949         bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
 950         bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
 951     } else {
 952         bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
 953         bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
 954         if {[tk windowingsystem] eq "aqua"} {
 955             bindall <MouseWheel> {
 956                 set delta [expr {- (%D)}]
 957                 allcanvs yview scroll $delta units
 958             }
 959         }
 960     }
 961     bindall <2> "canvscan mark %W %x %y"
 962     bindall <B2-Motion> "canvscan dragto %W %x %y"
 963     bindkey <Home> selfirstline
 964     bindkey <End> sellastline
 965     bind . <Key-Up> "selnextline -1"
 966     bind . <Key-Down> "selnextline 1"
 967     bind . <Shift-Key-Up> "dofind -1 0"
 968     bind . <Shift-Key-Down> "dofind 1 0"
 969     bindkey <Key-Right> "goforw"
 970     bindkey <Key-Left> "goback"
 971     bind . <Key-Prior> "selnextpage -1"
 972     bind . <Key-Next> "selnextpage 1"
 973     bind . <$M1B-Home> "allcanvs yview moveto 0.0"
 974     bind . <$M1B-End> "allcanvs yview moveto 1.0"
 975     bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
 976     bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
 977     bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
 978     bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
 979     bindkey <Key-Delete> "$ctext yview scroll -1 pages"
 980     bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
 981     bindkey <Key-space> "$ctext yview scroll 1 pages"
 982     bindkey p "selnextline -1"
 983     bindkey n "selnextline 1"
 984     bindkey z "goback"
 985     bindkey x "goforw"
 986     bindkey i "selnextline -1"
 987     bindkey k "selnextline 1"
 988     bindkey j "goback"
 989     bindkey l "goforw"
 990     bindkey b "$ctext yview scroll -1 pages"
 991     bindkey d "$ctext yview scroll 18 units"
 992     bindkey u "$ctext yview scroll -18 units"
 993     bindkey / {dofind 1 1}
 994     bindkey <Key-Return> {dofind 1 1}
 995     bindkey ? {dofind -1 1}
 996     bindkey f nextfile
 997     bindkey <F5> updatecommits
 998     bind . <$M1B-q> doquit
 999     bind . <$M1B-f> {dofind 1 1}
1000     bind . <$M1B-g> {dofind 1 0}
1001     bind . <$M1B-r> dosearchback
1002     bind . <$M1B-s> dosearch
1003     bind . <$M1B-equal> {incrfont 1}
1004     bind . <$M1B-plus> {incrfont 1}
1005     bind . <$M1B-KP_Add> {incrfont 1}
1006     bind . <$M1B-minus> {incrfont -1}
1007     bind . <$M1B-KP_Subtract> {incrfont -1}
1008     wm protocol . WM_DELETE_WINDOW doquit
1009     bind . <Button-1> "click %W"
1010     bind $fstring <Key-Return> {dofind 1 1}
1011     bind $sha1entry <Key-Return> gotocommit
1012     bind $sha1entry <<PasteSelection>> clearsha1
1013     bind $cflist <1> {sel_flist %W %x %y; break}
1014     bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
1015     bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
1016     bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
1017
1018     set maincursor [. cget -cursor]
1019     set textcursor [$ctext cget -cursor]
1020     set curtextcursor $textcursor
1021
1022     set rowctxmenu .rowctxmenu
1023     menu $rowctxmenu -tearoff 0
1024     $rowctxmenu add command -label [mc "Diff this -> selected"] \
1025         -command {diffvssel 0}
1026     $rowctxmenu add command -label [mc "Diff selected -> this"] \
1027         -command {diffvssel 1}
1028     $rowctxmenu add command -label [mc "Make patch"] -command mkpatch
1029     $rowctxmenu add command -label [mc "Create tag"] -command mktag
1030     $rowctxmenu add command -label [mc "Write commit to file"] -command writecommit
1031     $rowctxmenu add command -label [mc "Create new branch"] -command mkbranch
1032     $rowctxmenu add command -label [mc "Cherry-pick this commit"] \
1033         -command cherrypick
1034     $rowctxmenu add command -label [mc "Reset HEAD branch to here"] \
1035         -command resethead
1036
1037     set fakerowmenu .fakerowmenu
1038     menu $fakerowmenu -tearoff 0
1039     $fakerowmenu add command -label [mc "Diff this -> selected"] \
1040         -command {diffvssel 0}
1041     $fakerowmenu add command -label [mc "Diff selected -> this"] \
1042         -command {diffvssel 1}
1043     $fakerowmenu add command -label [mc "Make patch"] -command mkpatch
1044 #    $fakerowmenu add command -label [mc "Commit"] -command {mkcommit 0}
1045 #    $fakerowmenu add command -label [mc "Commit all"] -command {mkcommit 1}
1046 #    $fakerowmenu add command -label [mc "Revert local changes"] -command revertlocal
1047
1048     set headctxmenu .headctxmenu
1049     menu $headctxmenu -tearoff 0
1050     $headctxmenu add command -label [mc "Check out this branch"] \
1051         -command cobranch
1052     $headctxmenu add command -label [mc "Remove this branch"] \
1053         -command rmbranch
1054
1055     global flist_menu
1056     set flist_menu .flistctxmenu
1057     menu $flist_menu -tearoff 0
1058     $flist_menu add command -label [mc "Highlight this too"] \
1059         -command {flist_hl 0}
1060     $flist_menu add command -label [mc "Highlight this only"] \
1061         -command {flist_hl 1}
1062 }
1063
1064 # Windows sends all mouse wheel events to the current focused window, not
1065 # the one where the mouse hovers, so bind those events here and redirect
1066 # to the correct window
1067 proc windows_mousewheel_redirector {W X Y D} {
1068     global canv canv2 canv3
1069     set w [winfo containing -displayof $W $X $Y]
1070     if {$w ne ""} {
1071         set u [expr {$D < 0 ? 5 : -5}]
1072         if {$w == $canv || $w == $canv2 || $w == $canv3} {
1073             allcanvs yview scroll $u units
1074         } else {
1075             catch {
1076                 $w yview scroll $u units
1077             }
1078         }
1079     }
1080 }
1081
1082 # mouse-2 makes all windows scan vertically, but only the one
1083 # the cursor is in scans horizontally
1084 proc canvscan {op w x y} {
1085     global canv canv2 canv3
1086     foreach c [list $canv $canv2 $canv3] {
1087         if {$c == $w} {
1088             $c scan $op $x $y
1089         } else {
1090             $c scan $op 0 $y
1091         }
1092     }
1093 }
1094
1095 proc scrollcanv {cscroll f0 f1} {
1096     $cscroll set $f0 $f1
1097     drawfrac $f0 $f1
1098     flushhighlights
1099 }
1100
1101 # when we make a key binding for the toplevel, make sure
1102 # it doesn't get triggered when that key is pressed in the
1103 # find string entry widget.
1104 proc bindkey {ev script} {
1105     global entries
1106     bind . $ev $script
1107     set escript [bind Entry $ev]
1108     if {$escript == {}} {
1109         set escript [bind Entry <Key>]
1110     }
1111     foreach e $entries {
1112         bind $e $ev "$escript; break"
1113     }
1114 }
1115
1116 # set the focus back to the toplevel for any click outside
1117 # the entry widgets
1118 proc click {w} {
1119     global ctext entries
1120     foreach e [concat $entries $ctext] {
1121         if {$w == $e} return
1122     }
1123     focus .
1124 }
1125
1126 # Adjust the progress bar for a change in requested extent or canvas size
1127 proc adjustprogress {} {
1128     global progresscanv progressitem progresscoords
1129     global fprogitem fprogcoord lastprogupdate progupdatepending
1130     global rprogitem rprogcoord
1131
1132     set w [expr {[winfo width $progresscanv] - 4}]
1133     set x0 [expr {$w * [lindex $progresscoords 0]}]
1134     set x1 [expr {$w * [lindex $progresscoords 1]}]
1135     set h [winfo height $progresscanv]
1136     $progresscanv coords $progressitem $x0 0 $x1 $h
1137     $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
1138     $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
1139     set now [clock clicks -milliseconds]
1140     if {$now >= $lastprogupdate + 100} {
1141         set progupdatepending 0
1142         update
1143     } elseif {!$progupdatepending} {
1144         set progupdatepending 1
1145         after [expr {$lastprogupdate + 100 - $now}] doprogupdate
1146     }
1147 }
1148
1149 proc doprogupdate {} {
1150     global lastprogupdate progupdatepending
1151
1152     if {$progupdatepending} {
1153         set progupdatepending 0
1154         set lastprogupdate [clock clicks -milliseconds]
1155         update
1156     }
1157 }
1158
1159 proc savestuff {w} {
1160     global canv canv2 canv3 mainfont textfont uifont tabstop
1161     global stuffsaved findmergefiles maxgraphpct
1162     global maxwidth showneartags showlocalchanges
1163     global viewname viewfiles viewargs viewperm nextviewnum
1164     global cmitmode wrapcomment datetimeformat limitdiffs
1165     global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
1166
1167     if {$stuffsaved} return
1168     if {![winfo viewable .]} return
1169     catch {
1170         set f [open "~/.gitk-new" w]
1171         puts $f [list set mainfont $mainfont]
1172         puts $f [list set textfont $textfont]
1173         puts $f [list set uifont $uifont]
1174         puts $f [list set tabstop $tabstop]
1175         puts $f [list set findmergefiles $findmergefiles]
1176         puts $f [list set maxgraphpct $maxgraphpct]
1177         puts $f [list set maxwidth $maxwidth]
1178         puts $f [list set cmitmode $cmitmode]
1179         puts $f [list set wrapcomment $wrapcomment]
1180         puts $f [list set showneartags $showneartags]
1181         puts $f [list set showlocalchanges $showlocalchanges]
1182         puts $f [list set datetimeformat $datetimeformat]
1183         puts $f [list set limitdiffs $limitdiffs]
1184         puts $f [list set bgcolor $bgcolor]
1185         puts $f [list set fgcolor $fgcolor]
1186         puts $f [list set colors $colors]
1187         puts $f [list set diffcolors $diffcolors]
1188         puts $f [list set diffcontext $diffcontext]
1189         puts $f [list set selectbgcolor $selectbgcolor]
1190
1191         puts $f "set geometry(main) [wm geometry .]"
1192         puts $f "set geometry(topwidth) [winfo width .tf]"
1193         puts $f "set geometry(topheight) [winfo height .tf]"
1194         puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1195         puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
1196         puts $f "set geometry(botwidth) [winfo width .bleft]"
1197         puts $f "set geometry(botheight) [winfo height .bleft]"
1198
1199         puts -nonewline $f "set permviews {"
1200         for {set v 0} {$v < $nextviewnum} {incr v} {
1201             if {$viewperm($v)} {
1202                 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
1203             }
1204         }
1205         puts $f "}"
1206         close $f
1207         file rename -force "~/.gitk-new" "~/.gitk"
1208     }
1209     set stuffsaved 1
1210 }
1211
1212 proc resizeclistpanes {win w} {
1213     global oldwidth
1214     if {[info exists oldwidth($win)]} {
1215         set s0 [$win sash coord 0]
1216         set s1 [$win sash coord 1]
1217         if {$w < 60} {
1218             set sash0 [expr {int($w/2 - 2)}]
1219             set sash1 [expr {int($w*5/6 - 2)}]
1220         } else {
1221             set factor [expr {1.0 * $w / $oldwidth($win)}]
1222             set sash0 [expr {int($factor * [lindex $s0 0])}]
1223             set sash1 [expr {int($factor * [lindex $s1 0])}]
1224             if {$sash0 < 30} {
1225                 set sash0 30
1226             }
1227             if {$sash1 < $sash0 + 20} {
1228                 set sash1 [expr {$sash0 + 20}]
1229             }
1230             if {$sash1 > $w - 10} {
1231                 set sash1 [expr {$w - 10}]
1232                 if {$sash0 > $sash1 - 20} {
1233                     set sash0 [expr {$sash1 - 20}]
1234                 }
1235             }
1236         }
1237         $win sash place 0 $sash0 [lindex $s0 1]
1238         $win sash place 1 $sash1 [lindex $s1 1]
1239     }
1240     set oldwidth($win) $w
1241 }
1242
1243 proc resizecdetpanes {win w} {
1244     global oldwidth
1245     if {[info exists oldwidth($win)]} {
1246         set s0 [$win sash coord 0]
1247         if {$w < 60} {
1248             set sash0 [expr {int($w*3/4 - 2)}]
1249         } else {
1250             set factor [expr {1.0 * $w / $oldwidth($win)}]
1251             set sash0 [expr {int($factor * [lindex $s0 0])}]
1252             if {$sash0 < 45} {
1253                 set sash0 45
1254             }
1255             if {$sash0 > $w - 15} {
1256                 set sash0 [expr {$w - 15}]
1257             }
1258         }
1259         $win sash place 0 $sash0 [lindex $s0 1]
1260     }
1261     set oldwidth($win) $w
1262 }
1263
1264 proc allcanvs args {
1265     global canv canv2 canv3
1266     eval $canv $args
1267     eval $canv2 $args
1268     eval $canv3 $args
1269 }
1270
1271 proc bindall {event action} {
1272     global canv canv2 canv3
1273     bind $canv $event $action
1274     bind $canv2 $event $action
1275     bind $canv3 $event $action
1276 }
1277
1278 proc about {} {
1279     global uifont
1280     set w .about
1281     if {[winfo exists $w]} {
1282         raise $w
1283         return
1284     }
1285     toplevel $w
1286     wm title $w [mc "About gitk"]
1287     message $w.m -text [mc "
1288 Gitk - a commit viewer for git
1289
1290 Copyright © 2005-2006 Paul Mackerras
1291
1292 Use and redistribute under the terms of the GNU General Public License"] \
1293             -justify center -aspect 400 -border 2 -bg white -relief groove
1294     pack $w.m -side top -fill x -padx 2 -pady 2
1295     button $w.ok -text [mc "Close"] -command "destroy $w" -default active
1296     pack $w.ok -side bottom
1297     bind $w <Visibility> "focus $w.ok"
1298     bind $w <Key-Escape> "destroy $w"
1299     bind $w <Key-Return> "destroy $w"
1300 }
1301
1302 proc keys {} {
1303     set w .keys
1304     if {[winfo exists $w]} {
1305         raise $w
1306         return
1307     }
1308     if {[tk windowingsystem] eq {aqua}} {
1309         set M1T Cmd
1310     } else {
1311         set M1T Ctrl
1312     }
1313     toplevel $w
1314     wm title $w [mc "Gitk key bindings"]
1315     message $w.m -text "
1316 [mc "Gitk key bindings:"]
1317
1318 [mc "<%s-Q>             Quit" $M1T]
1319 [mc "<Home>             Move to first commit"]
1320 [mc "<End>              Move to last commit"]
1321 [mc "<Up>, p, i Move up one commit"]
1322 [mc "<Down>, n, k       Move down one commit"]
1323 [mc "<Left>, z, j       Go back in history list"]
1324 [mc "<Right>, x, l      Go forward in history list"]
1325 [mc "<PageUp>   Move up one page in commit list"]
1326 [mc "<PageDown> Move down one page in commit list"]
1327 [mc "<%s-Home>  Scroll to top of commit list" $M1T]
1328 [mc "<%s-End>   Scroll to bottom of commit list" $M1T]
1329 [mc "<%s-Up>    Scroll commit list up one line" $M1T]
1330 [mc "<%s-Down>  Scroll commit list down one line" $M1T]
1331 [mc "<%s-PageUp>        Scroll commit list up one page" $M1T]
1332 [mc "<%s-PageDown>      Scroll commit list down one page" $M1T]
1333 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
1334 [mc "<Shift-Down>       Find forwards (downwards, earlier commits)"]
1335 [mc "<Delete>, b        Scroll diff view up one page"]
1336 [mc "<Backspace>        Scroll diff view up one page"]
1337 [mc "<Space>            Scroll diff view down one page"]
1338 [mc "u          Scroll diff view up 18 lines"]
1339 [mc "d          Scroll diff view down 18 lines"]
1340 [mc "<%s-F>             Find" $M1T]
1341 [mc "<%s-G>             Move to next find hit" $M1T]
1342 [mc "<Return>   Move to next find hit"]
1343 [mc "/          Move to next find hit, or redo find"]
1344 [mc "?          Move to previous find hit"]
1345 [mc "f          Scroll diff view to next file"]
1346 [mc "<%s-S>             Search for next hit in diff view" $M1T]
1347 [mc "<%s-R>             Search for previous hit in diff view" $M1T]
1348 [mc "<%s-KP+>   Increase font size" $M1T]
1349 [mc "<%s-plus>  Increase font size" $M1T]
1350 [mc "<%s-KP->   Decrease font size" $M1T]
1351 [mc "<%s-minus> Decrease font size" $M1T]
1352 [mc "<F5>               Update"]
1353 " \
1354             -justify left -bg white -border 2 -relief groove
1355     pack $w.m -side top -fill both -padx 2 -pady 2
1356     button $w.ok -text [mc "Close"] -command "destroy $w" -default active
1357     pack $w.ok -side bottom
1358     bind $w <Visibility> "focus $w.ok"
1359     bind $w <Key-Escape> "destroy $w"
1360     bind $w <Key-Return> "destroy $w"
1361 }
1362
1363 # Procedures for manipulating the file list window at the
1364 # bottom right of the overall window.
1365
1366 proc treeview {w l openlevs} {
1367     global treecontents treediropen treeheight treeparent treeindex
1368
1369     set ix 0
1370     set treeindex() 0
1371     set lev 0
1372     set prefix {}
1373     set prefixend -1
1374     set prefendstack {}
1375     set htstack {}
1376     set ht 0
1377     set treecontents() {}
1378     $w conf -state normal
1379     foreach f $l {
1380         while {[string range $f 0 $prefixend] ne $prefix} {
1381             if {$lev <= $openlevs} {
1382                 $w mark set e:$treeindex($prefix) "end -1c"
1383                 $w mark gravity e:$treeindex($prefix) left
1384             }
1385             set treeheight($prefix) $ht
1386             incr ht [lindex $htstack end]
1387             set htstack [lreplace $htstack end end]
1388             set prefixend [lindex $prefendstack end]
1389             set prefendstack [lreplace $prefendstack end end]
1390             set prefix [string range $prefix 0 $prefixend]
1391             incr lev -1
1392         }
1393         set tail [string range $f [expr {$prefixend+1}] end]
1394         while {[set slash [string first "/" $tail]] >= 0} {
1395             lappend htstack $ht
1396             set ht 0
1397             lappend prefendstack $prefixend
1398             incr prefixend [expr {$slash + 1}]
1399             set d [string range $tail 0 $slash]
1400             lappend treecontents($prefix) $d
1401             set oldprefix $prefix
1402             append prefix $d
1403             set treecontents($prefix) {}
1404             set treeindex($prefix) [incr ix]
1405             set treeparent($prefix) $oldprefix
1406             set tail [string range $tail [expr {$slash+1}] end]
1407             if {$lev <= $openlevs} {
1408                 set ht 1
1409                 set treediropen($prefix) [expr {$lev < $openlevs}]
1410                 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1411                 $w mark set d:$ix "end -1c"
1412                 $w mark gravity d:$ix left
1413                 set str "\n"
1414                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1415                 $w insert end $str
1416                 $w image create end -align center -image $bm -padx 1 \
1417                     -name a:$ix
1418                 $w insert end $d [highlight_tag $prefix]
1419                 $w mark set s:$ix "end -1c"
1420                 $w mark gravity s:$ix left
1421             }
1422             incr lev
1423         }
1424         if {$tail ne {}} {
1425             if {$lev <= $openlevs} {
1426                 incr ht
1427                 set str "\n"
1428                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1429                 $w insert end $str
1430                 $w insert end $tail [highlight_tag $f]
1431             }
1432             lappend treecontents($prefix) $tail
1433         }
1434     }
1435     while {$htstack ne {}} {
1436         set treeheight($prefix) $ht
1437         incr ht [lindex $htstack end]
1438         set htstack [lreplace $htstack end end]
1439         set prefixend [lindex $prefendstack end]
1440         set prefendstack [lreplace $prefendstack end end]
1441         set prefix [string range $prefix 0 $prefixend]
1442     }
1443     $w conf -state disabled
1444 }
1445
1446 proc linetoelt {l} {
1447     global treeheight treecontents
1448
1449     set y 2
1450     set prefix {}
1451     while {1} {
1452         foreach e $treecontents($prefix) {
1453             if {$y == $l} {
1454                 return "$prefix$e"
1455             }
1456             set n 1
1457             if {[string index $e end] eq "/"} {
1458                 set n $treeheight($prefix$e)
1459                 if {$y + $n > $l} {
1460                     append prefix $e
1461                     incr y
1462                     break
1463                 }
1464             }
1465             incr y $n
1466         }
1467     }
1468 }
1469
1470 proc highlight_tree {y prefix} {
1471     global treeheight treecontents cflist
1472
1473     foreach e $treecontents($prefix) {
1474         set path $prefix$e
1475         if {[highlight_tag $path] ne {}} {
1476             $cflist tag add bold $y.0 "$y.0 lineend"
1477         }
1478         incr y
1479         if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1480             set y [highlight_tree $y $path]
1481         }
1482     }
1483     return $y
1484 }
1485
1486 proc treeclosedir {w dir} {
1487     global treediropen treeheight treeparent treeindex
1488
1489     set ix $treeindex($dir)
1490     $w conf -state normal
1491     $w delete s:$ix e:$ix
1492     set treediropen($dir) 0
1493     $w image configure a:$ix -image tri-rt
1494     $w conf -state disabled
1495     set n [expr {1 - $treeheight($dir)}]
1496     while {$dir ne {}} {
1497         incr treeheight($dir) $n
1498         set dir $treeparent($dir)
1499     }
1500 }
1501
1502 proc treeopendir {w dir} {
1503     global treediropen treeheight treeparent treecontents treeindex
1504
1505     set ix $treeindex($dir)
1506     $w conf -state normal
1507     $w image configure a:$ix -image tri-dn
1508     $w mark set e:$ix s:$ix
1509     $w mark gravity e:$ix right
1510     set lev 0
1511     set str "\n"
1512     set n [llength $treecontents($dir)]
1513     for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1514         incr lev
1515         append str "\t"
1516         incr treeheight($x) $n
1517     }
1518     foreach e $treecontents($dir) {
1519         set de $dir$e
1520         if {[string index $e end] eq "/"} {
1521             set iy $treeindex($de)
1522             $w mark set d:$iy e:$ix
1523             $w mark gravity d:$iy left
1524             $w insert e:$ix $str
1525             set treediropen($de) 0
1526             $w image create e:$ix -align center -image tri-rt -padx 1 \
1527                 -name a:$iy
1528             $w insert e:$ix $e [highlight_tag $de]
1529             $w mark set s:$iy e:$ix
1530             $w mark gravity s:$iy left
1531             set treeheight($de) 1
1532         } else {
1533             $w insert e:$ix $str
1534             $w insert e:$ix $e [highlight_tag $de]
1535         }
1536     }
1537     $w mark gravity e:$ix left
1538     $w conf -state disabled
1539     set treediropen($dir) 1
1540     set top [lindex [split [$w index @0,0] .] 0]
1541     set ht [$w cget -height]
1542     set l [lindex [split [$w index s:$ix] .] 0]
1543     if {$l < $top} {
1544         $w yview $l.0
1545     } elseif {$l + $n + 1 > $top + $ht} {
1546         set top [expr {$l + $n + 2 - $ht}]
1547         if {$l < $top} {
1548             set top $l
1549         }
1550         $w yview $top.0
1551     }
1552 }
1553
1554 proc treeclick {w x y} {
1555     global treediropen cmitmode ctext cflist cflist_top
1556
1557     if {$cmitmode ne "tree"} return
1558     if {![info exists cflist_top]} return
1559     set l [lindex [split [$w index "@$x,$y"] "."] 0]
1560     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1561     $cflist tag add highlight $l.0 "$l.0 lineend"
1562     set cflist_top $l
1563     if {$l == 1} {
1564         $ctext yview 1.0
1565         return
1566     }
1567     set e [linetoelt $l]
1568     if {[string index $e end] ne "/"} {
1569         showfile $e
1570     } elseif {$treediropen($e)} {
1571         treeclosedir $w $e
1572     } else {
1573         treeopendir $w $e
1574     }
1575 }
1576
1577 proc setfilelist {id} {
1578     global treefilelist cflist
1579
1580     treeview $cflist $treefilelist($id) 0
1581 }
1582
1583 image create bitmap tri-rt -background black -foreground blue -data {
1584     #define tri-rt_width 13
1585     #define tri-rt_height 13
1586     static unsigned char tri-rt_bits[] = {
1587        0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1588        0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1589        0x00, 0x00};
1590 } -maskdata {
1591     #define tri-rt-mask_width 13
1592     #define tri-rt-mask_height 13
1593     static unsigned char tri-rt-mask_bits[] = {
1594        0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1595        0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1596        0x08, 0x00};
1597 }
1598 image create bitmap tri-dn -background black -foreground blue -data {
1599     #define tri-dn_width 13
1600     #define tri-dn_height 13
1601     static unsigned char tri-dn_bits[] = {
1602        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1603        0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1604        0x00, 0x00};
1605 } -maskdata {
1606     #define tri-dn-mask_width 13
1607     #define tri-dn-mask_height 13
1608     static unsigned char tri-dn-mask_bits[] = {
1609        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1610        0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1611        0x00, 0x00};
1612 }
1613
1614 image create bitmap reficon-T -background black -foreground yellow -data {
1615     #define tagicon_width 13
1616     #define tagicon_height 9
1617     static unsigned char tagicon_bits[] = {
1618        0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
1619        0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
1620 } -maskdata {
1621     #define tagicon-mask_width 13
1622     #define tagicon-mask_height 9
1623     static unsigned char tagicon-mask_bits[] = {
1624        0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
1625        0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
1626 }
1627 set rectdata {
1628     #define headicon_width 13
1629     #define headicon_height 9
1630     static unsigned char headicon_bits[] = {
1631        0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
1632        0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
1633 }
1634 set rectmask {
1635     #define headicon-mask_width 13
1636     #define headicon-mask_height 9
1637     static unsigned char headicon-mask_bits[] = {
1638        0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
1639        0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
1640 }
1641 image create bitmap reficon-H -background black -foreground green \
1642     -data $rectdata -maskdata $rectmask
1643 image create bitmap reficon-o -background black -foreground "#ddddff" \
1644     -data $rectdata -maskdata $rectmask
1645
1646 proc init_flist {first} {
1647     global cflist cflist_top selectedline difffilestart
1648
1649     $cflist conf -state normal
1650     $cflist delete 0.0 end
1651     if {$first ne {}} {
1652         $cflist insert end $first
1653         set cflist_top 1
1654         $cflist tag add highlight 1.0 "1.0 lineend"
1655     } else {
1656         catch {unset cflist_top}
1657     }
1658     $cflist conf -state disabled
1659     set difffilestart {}
1660 }
1661
1662 proc highlight_tag {f} {
1663     global highlight_paths
1664
1665     foreach p $highlight_paths {
1666         if {[string match $p $f]} {
1667             return "bold"
1668         }
1669     }
1670     return {}
1671 }
1672
1673 proc highlight_filelist {} {
1674     global cmitmode cflist
1675
1676     $cflist conf -state normal
1677     if {$cmitmode ne "tree"} {
1678         set end [lindex [split [$cflist index end] .] 0]
1679         for {set l 2} {$l < $end} {incr l} {
1680             set line [$cflist get $l.0 "$l.0 lineend"]
1681             if {[highlight_tag $line] ne {}} {
1682                 $cflist tag add bold $l.0 "$l.0 lineend"
1683             }
1684         }
1685     } else {
1686         highlight_tree 2 {}
1687     }
1688     $cflist conf -state disabled
1689 }
1690
1691 proc unhighlight_filelist {} {
1692     global cflist
1693
1694     $cflist conf -state normal
1695     $cflist tag remove bold 1.0 end
1696     $cflist conf -state disabled
1697 }
1698
1699 proc add_flist {fl} {
1700     global cflist
1701
1702     $cflist conf -state normal
1703     foreach f $fl {
1704         $cflist insert end "\n"
1705         $cflist insert end $f [highlight_tag $f]
1706     }
1707     $cflist conf -state disabled
1708 }
1709
1710 proc sel_flist {w x y} {
1711     global ctext difffilestart cflist cflist_top cmitmode
1712
1713     if {$cmitmode eq "tree"} return
1714     if {![info exists cflist_top]} return
1715     set l [lindex [split [$w index "@$x,$y"] "."] 0]
1716     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1717     $cflist tag add highlight $l.0 "$l.0 lineend"
1718     set cflist_top $l
1719     if {$l == 1} {
1720         $ctext yview 1.0
1721     } else {
1722         catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1723     }
1724 }
1725
1726 proc pop_flist_menu {w X Y x y} {
1727     global ctext cflist cmitmode flist_menu flist_menu_file
1728     global treediffs diffids
1729
1730     stopfinding
1731     set l [lindex [split [$w index "@$x,$y"] "."] 0]
1732     if {$l <= 1} return
1733     if {$cmitmode eq "tree"} {
1734         set e [linetoelt $l]
1735         if {[string index $e end] eq "/"} return
1736     } else {
1737         set e [lindex $treediffs($diffids) [expr {$l-2}]]
1738     }
1739     set flist_menu_file $e
1740     tk_popup $flist_menu $X $Y
1741 }
1742
1743 proc flist_hl {only} {
1744     global flist_menu_file findstring gdttype
1745
1746     set x [shellquote $flist_menu_file]
1747     if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
1748         set findstring $x
1749     } else {
1750         append findstring " " $x
1751     }
1752     set gdttype [mc "touching paths:"]
1753 }
1754
1755 # Functions for adding and removing shell-type quoting
1756
1757 proc shellquote {str} {
1758     if {![string match "*\['\"\\ \t]*" $str]} {
1759         return $str
1760     }
1761     if {![string match "*\['\"\\]*" $str]} {
1762         return "\"$str\""
1763     }
1764     if {![string match "*'*" $str]} {
1765         return "'$str'"
1766     }
1767     return "\"[string map {\" \\\" \\ \\\\} $str]\""
1768 }
1769
1770 proc shellarglist {l} {
1771     set str {}
1772     foreach a $l {
1773         if {$str ne {}} {
1774             append str " "
1775         }
1776         append str [shellquote $a]
1777     }
1778     return $str
1779 }
1780
1781 proc shelldequote {str} {
1782     set ret {}
1783     set used -1
1784     while {1} {
1785         incr used
1786         if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1787             append ret [string range $str $used end]
1788             set used [string length $str]
1789             break
1790         }
1791         set first [lindex $first 0]
1792         set ch [string index $str $first]
1793         if {$first > $used} {
1794             append ret [string range $str $used [expr {$first - 1}]]
1795             set used $first
1796         }
1797         if {$ch eq " " || $ch eq "\t"} break
1798         incr used
1799         if {$ch eq "'"} {
1800             set first [string first "'" $str $used]
1801             if {$first < 0} {
1802                 error "unmatched single-quote"
1803             }
1804             append ret [string range $str $used [expr {$first - 1}]]
1805             set used $first
1806             continue
1807         }
1808         if {$ch eq "\\"} {
1809             if {$used >= [string length $str]} {
1810                 error "trailing backslash"
1811             }
1812             append ret [string index $str $used]
1813             continue
1814         }
1815         # here ch == "\""
1816         while {1} {
1817             if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1818                 error "unmatched double-quote"
1819             }
1820             set first [lindex $first 0]
1821             set ch [string index $str $first]
1822             if {$first > $used} {
1823                 append ret [string range $str $used [expr {$first - 1}]]
1824                 set used $first
1825             }
1826             if {$ch eq "\""} break
1827             incr used
1828             append ret [string index $str $used]
1829             incr used
1830         }
1831     }
1832     return [list $used $ret]
1833 }
1834
1835 proc shellsplit {str} {
1836     set l {}
1837     while {1} {
1838         set str [string trimleft $str]
1839         if {$str eq {}} break
1840         set dq [shelldequote $str]
1841         set n [lindex $dq 0]
1842         set word [lindex $dq 1]
1843         set str [string range $str $n end]
1844         lappend l $word
1845     }
1846     return $l
1847 }
1848
1849 # Code to implement multiple views
1850
1851 proc newview {ishighlight} {
1852     global nextviewnum newviewname newviewperm newishighlight
1853     global newviewargs revtreeargs
1854
1855     set newishighlight $ishighlight
1856     set top .gitkview
1857     if {[winfo exists $top]} {
1858         raise $top
1859         return
1860     }
1861     set newviewname($nextviewnum) "View $nextviewnum"
1862     set newviewperm($nextviewnum) 0
1863     set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1864     vieweditor $top $nextviewnum [mc "Gitk view definition"]
1865 }
1866
1867 proc editview {} {
1868     global curview
1869     global viewname viewperm newviewname newviewperm
1870     global viewargs newviewargs
1871
1872     set top .gitkvedit-$curview
1873     if {[winfo exists $top]} {
1874         raise $top
1875         return
1876     }
1877     set newviewname($curview) $viewname($curview)
1878     set newviewperm($curview) $viewperm($curview)
1879     set newviewargs($curview) [shellarglist $viewargs($curview)]
1880     vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1881 }
1882
1883 proc vieweditor {top n title} {
1884     global newviewname newviewperm viewfiles bgcolor
1885
1886     toplevel $top
1887     wm title $top $title
1888     label $top.nl -text [mc "Name"]
1889     entry $top.name -width 20 -textvariable newviewname($n)
1890     grid $top.nl $top.name -sticky w -pady 5
1891     checkbutton $top.perm -text [mc "Remember this view"] \
1892         -variable newviewperm($n)
1893     grid $top.perm - -pady 5 -sticky w
1894     message $top.al -aspect 1000 \
1895         -text [mc "Commits to include (arguments to git rev-list):"]
1896     grid $top.al - -sticky w -pady 5
1897     entry $top.args -width 50 -textvariable newviewargs($n) \
1898         -background $bgcolor
1899     grid $top.args - -sticky ew -padx 5
1900     message $top.l -aspect 1000 \
1901         -text [mc "Enter files and directories to include, one per line:"]
1902     grid $top.l - -sticky w
1903     text $top.t -width 40 -height 10 -background $bgcolor -font uifont
1904     if {[info exists viewfiles($n)]} {
1905         foreach f $viewfiles($n) {
1906             $top.t insert end $f
1907             $top.t insert end "\n"
1908         }
1909         $top.t delete {end - 1c} end
1910         $top.t mark set insert 0.0
1911     }
1912     grid $top.t - -sticky ew -padx 5
1913     frame $top.buts
1914     button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
1915     button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
1916     grid $top.buts.ok $top.buts.can
1917     grid columnconfigure $top.buts 0 -weight 1 -uniform a
1918     grid columnconfigure $top.buts 1 -weight 1 -uniform a
1919     grid $top.buts - -pady 10 -sticky ew
1920     focus $top.t
1921 }
1922
1923 proc doviewmenu {m first cmd op argv} {
1924     set nmenu [$m index end]
1925     for {set i $first} {$i <= $nmenu} {incr i} {
1926         if {[$m entrycget $i -command] eq $cmd} {
1927             eval $m $op $i $argv
1928             break
1929         }
1930     }
1931 }
1932
1933 proc allviewmenus {n op args} {
1934     # global viewhlmenu
1935
1936     doviewmenu .bar.view 5 [list showview $n] $op $args
1937     # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1938 }
1939
1940 proc newviewok {top n} {
1941     global nextviewnum newviewperm newviewname newishighlight
1942     global viewname viewfiles viewperm selectedview curview
1943     global viewargs newviewargs viewhlmenu
1944
1945     if {[catch {
1946         set newargs [shellsplit $newviewargs($n)]
1947     } err]} {
1948         error_popup "[mc "Error in commit selection arguments:"] $err"
1949         wm raise $top
1950         focus $top
1951         return
1952     }
1953     set files {}
1954     foreach f [split [$top.t get 0.0 end] "\n"] {
1955         set ft [string trim $f]
1956         if {$ft ne {}} {
1957             lappend files $ft
1958         }
1959     }
1960     if {![info exists viewfiles($n)]} {
1961         # creating a new view
1962         incr nextviewnum
1963         set viewname($n) $newviewname($n)
1964         set viewperm($n) $newviewperm($n)
1965         set viewfiles($n) $files
1966         set viewargs($n) $newargs
1967         addviewmenu $n
1968         if {!$newishighlight} {
1969             run showview $n
1970         } else {
1971             run addvhighlight $n
1972         }
1973     } else {
1974         # editing an existing view
1975         set viewperm($n) $newviewperm($n)
1976         if {$newviewname($n) ne $viewname($n)} {
1977             set viewname($n) $newviewname($n)
1978             doviewmenu .bar.view 5 [list showview $n] \
1979                 entryconf [list -label $viewname($n)]
1980             # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1981                 # entryconf [list -label $viewname($n) -value $viewname($n)]
1982         }
1983         if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1984             set viewfiles($n) $files
1985             set viewargs($n) $newargs
1986             if {$curview == $n} {
1987                 run updatecommits
1988             }
1989         }
1990     }
1991     catch {destroy $top}
1992 }
1993
1994 proc delview {} {
1995     global curview viewdata viewperm hlview selectedhlview
1996
1997     if {$curview == 0} return
1998     if {[info exists hlview] && $hlview == $curview} {
1999         set selectedhlview [mc "None"]
2000         unset hlview
2001     }
2002     allviewmenus $curview delete
2003     set viewdata($curview) {}
2004     set viewperm($curview) 0
2005     showview 0
2006 }
2007
2008 proc addviewmenu {n} {
2009     global viewname viewhlmenu
2010
2011     .bar.view add radiobutton -label $viewname($n) \
2012         -command [list showview $n] -variable selectedview -value $n
2013     #$viewhlmenu add radiobutton -label $viewname($n) \
2014     #   -command [list addvhighlight $n] -variable selectedhlview
2015 }
2016
2017 proc flatten {var} {
2018     global $var
2019
2020     set ret {}
2021     foreach i [array names $var] {
2022         lappend ret $i [set $var\($i\)]
2023     }
2024     return $ret
2025 }
2026
2027 proc unflatten {var l} {
2028     global $var
2029
2030     catch {unset $var}
2031     foreach {i v} $l {
2032         set $var\($i\) $v
2033     }
2034 }
2035
2036 proc showview {n} {
2037     global curview viewdata viewfiles
2038     global displayorder parentlist rowidlist rowisopt rowfinal
2039     global colormap rowtextx commitrow nextcolor canvxmax
2040     global numcommits commitlisted
2041     global selectedline currentid canv canvy0
2042     global treediffs
2043     global pending_select phase
2044     global commitidx
2045     global commfd
2046     global selectedview selectfirst
2047     global vparentlist vdisporder vcmitlisted
2048     global hlview selectedhlview commitinterest
2049
2050     if {$n == $curview} return
2051     set selid {}
2052     if {[info exists selectedline]} {
2053         set selid $currentid
2054         set y [yc $selectedline]
2055         set ymax [lindex [$canv cget -scrollregion] 3]
2056         set span [$canv yview]
2057         set ytop [expr {[lindex $span 0] * $ymax}]
2058         set ybot [expr {[lindex $span 1] * $ymax}]
2059         if {$ytop < $y && $y < $ybot} {
2060             set yscreen [expr {$y - $ytop}]
2061         } else {
2062             set yscreen [expr {($ybot - $ytop) / 2}]
2063         }
2064     } elseif {[info exists pending_select]} {
2065         set selid $pending_select
2066         unset pending_select
2067     }
2068     unselectline
2069     normalline
2070     if {$curview >= 0} {
2071         set vparentlist($curview) $parentlist
2072         set vdisporder($curview) $displayorder
2073         set vcmitlisted($curview) $commitlisted
2074         if {$phase ne {} ||
2075             ![info exists viewdata($curview)] ||
2076             [lindex $viewdata($curview) 0] ne {}} {
2077             set viewdata($curview) \
2078                 [list $phase $rowidlist $rowisopt $rowfinal]
2079         }
2080     }
2081     catch {unset treediffs}
2082     clear_display
2083     if {[info exists hlview] && $hlview == $n} {
2084         unset hlview
2085         set selectedhlview [mc "None"]
2086     }
2087     catch {unset commitinterest}
2088
2089     set curview $n
2090     set selectedview $n
2091     .bar.view entryconf [mc "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
2092     .bar.view entryconf [mc "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
2093
2094     run refill_reflist
2095     if {![info exists viewdata($n)]} {
2096         if {$selid ne {}} {
2097             set pending_select $selid
2098         }
2099         getcommits
2100         return
2101     }
2102
2103     set v $viewdata($n)
2104     set phase [lindex $v 0]
2105     set displayorder $vdisporder($n)
2106     set parentlist $vparentlist($n)
2107     set commitlisted $vcmitlisted($n)
2108     set rowidlist [lindex $v 1]
2109     set rowisopt [lindex $v 2]
2110     set rowfinal [lindex $v 3]
2111     set numcommits $commitidx($n)
2112
2113     catch {unset colormap}
2114     catch {unset rowtextx}
2115     set nextcolor 0
2116     set canvxmax [$canv cget -width]
2117     set curview $n
2118     set row 0
2119     setcanvscroll
2120     set yf 0
2121     set row {}
2122     set selectfirst 0
2123     if {$selid ne {} && [info exists commitrow($n,$selid)]} {
2124         set row $commitrow($n,$selid)
2125         # try to get the selected row in the same position on the screen
2126         set ymax [lindex [$canv cget -scrollregion] 3]
2127         set ytop [expr {[yc $row] - $yscreen}]
2128         if {$ytop < 0} {
2129             set ytop 0
2130         }
2131         set yf [expr {$ytop * 1.0 / $ymax}]
2132     }
2133     allcanvs yview moveto $yf
2134     drawvisible
2135     if {$row ne {}} {
2136         selectline $row 0
2137     } elseif {$selid ne {}} {
2138         set pending_select $selid
2139     } else {
2140         set row [first_real_row]
2141         if {$row < $numcommits} {
2142             selectline $row 0
2143         } else {
2144             set selectfirst 1
2145         }
2146     }
2147     if {$phase ne {}} {
2148         if {$phase eq "getcommits"} {
2149             show_status [mc "Reading commits..."]
2150         }
2151         run chewcommits $n
2152     } elseif {$numcommits == 0} {
2153         show_status [mc "No commits selected"]
2154     }
2155 }
2156
2157 # Stuff relating to the highlighting facility
2158
2159 proc ishighlighted {row} {
2160     global vhighlights fhighlights nhighlights rhighlights
2161
2162     if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
2163         return $nhighlights($row)
2164     }
2165     if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
2166         return $vhighlights($row)
2167     }
2168     if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
2169         return $fhighlights($row)
2170     }
2171     if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
2172         return $rhighlights($row)
2173     }
2174     return 0
2175 }
2176
2177 proc bolden {row font} {
2178     global canv linehtag selectedline boldrows
2179
2180     lappend boldrows $row
2181     $canv itemconf $linehtag($row) -font $font
2182     if {[info exists selectedline] && $row == $selectedline} {
2183         $canv delete secsel
2184         set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2185                    -outline {{}} -tags secsel \
2186                    -fill [$canv cget -selectbackground]]
2187         $canv lower $t
2188     }
2189 }
2190
2191 proc bolden_name {row font} {
2192     global canv2 linentag selectedline boldnamerows
2193
2194     lappend boldnamerows $row
2195     $canv2 itemconf $linentag($row) -font $font
2196     if {[info exists selectedline] && $row == $selectedline} {
2197         $canv2 delete secsel
2198         set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2199                    -outline {{}} -tags secsel \
2200                    -fill [$canv2 cget -selectbackground]]
2201         $canv2 lower $t
2202     }
2203 }
2204
2205 proc unbolden {} {
2206     global boldrows
2207
2208     set stillbold {}
2209     foreach row $boldrows {
2210         if {![ishighlighted $row]} {
2211             bolden $row mainfont
2212         } else {
2213             lappend stillbold $row
2214         }
2215     }
2216     set boldrows $stillbold
2217 }
2218
2219 proc addvhighlight {n} {
2220     global hlview curview viewdata vhl_done vhighlights commitidx
2221
2222     if {[info exists hlview]} {
2223         delvhighlight
2224     }
2225     set hlview $n
2226     if {$n != $curview && ![info exists viewdata($n)]} {
2227         set viewdata($n) [list getcommits {{}} 0 0 0]
2228         set vparentlist($n) {}
2229         set vdisporder($n) {}
2230         set vcmitlisted($n) {}
2231         start_rev_list $n
2232     }
2233     set vhl_done $commitidx($hlview)
2234     if {$vhl_done > 0} {
2235         drawvisible
2236     }
2237 }
2238
2239 proc delvhighlight {} {
2240     global hlview vhighlights
2241
2242     if {![info exists hlview]} return
2243     unset hlview
2244     catch {unset vhighlights}
2245     unbolden
2246 }
2247
2248 proc vhighlightmore {} {
2249     global hlview vhl_done commitidx vhighlights
2250     global displayorder vdisporder curview
2251
2252     set max $commitidx($hlview)
2253     if {$hlview == $curview} {
2254         set disp $displayorder
2255     } else {
2256         set disp $vdisporder($hlview)
2257     }
2258     set vr [visiblerows]
2259     set r0 [lindex $vr 0]
2260     set r1 [lindex $vr 1]
2261     for {set i $vhl_done} {$i < $max} {incr i} {
2262         set id [lindex $disp $i]
2263         if {[info exists commitrow($curview,$id)]} {
2264             set row $commitrow($curview,$id)
2265             if {$r0 <= $row && $row <= $r1} {
2266                 if {![highlighted $row]} {
2267                     bolden $row mainfontbold
2268                 }
2269                 set vhighlights($row) 1
2270             }
2271         }
2272     }
2273     set vhl_done $max
2274 }
2275
2276 proc askvhighlight {row id} {
2277     global hlview vhighlights commitrow iddrawn
2278
2279     if {[info exists commitrow($hlview,$id)]} {
2280         if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2281             bolden $row mainfontbold
2282         }
2283         set vhighlights($row) 1
2284     } else {
2285         set vhighlights($row) 0
2286     }
2287 }
2288
2289 proc hfiles_change {} {
2290     global highlight_files filehighlight fhighlights fh_serial
2291     global highlight_paths gdttype
2292
2293     if {[info exists filehighlight]} {
2294         # delete previous highlights
2295         catch {close $filehighlight}
2296         unset filehighlight
2297         catch {unset fhighlights}
2298         unbolden
2299         unhighlight_filelist
2300     }
2301     set highlight_paths {}
2302     after cancel do_file_hl $fh_serial
2303     incr fh_serial
2304     if {$highlight_files ne {}} {
2305         after 300 do_file_hl $fh_serial
2306     }
2307 }
2308
2309 proc gdttype_change {name ix op} {
2310     global gdttype highlight_files findstring findpattern
2311
2312     stopfinding
2313     if {$findstring ne {}} {
2314         if {$gdttype eq [mc "containing:"]} {
2315             if {$highlight_files ne {}} {
2316                 set highlight_files {}
2317                 hfiles_change
2318             }
2319             findcom_change
2320         } else {
2321             if {$findpattern ne {}} {
2322                 set findpattern {}
2323                 findcom_change
2324             }
2325             set highlight_files $findstring
2326             hfiles_change
2327         }
2328         drawvisible
2329     }
2330     # enable/disable findtype/findloc menus too
2331 }
2332
2333 proc find_change {name ix op} {
2334     global gdttype findstring highlight_files
2335
2336     stopfinding
2337     if {$gdttype eq [mc "containing:"]} {
2338         findcom_change
2339     } else {
2340         if {$highlight_files ne $findstring} {
2341             set highlight_files $findstring
2342             hfiles_change
2343         }
2344     }
2345     drawvisible
2346 }
2347
2348 proc findcom_change args {
2349     global nhighlights boldnamerows
2350     global findpattern findtype findstring gdttype
2351
2352     stopfinding
2353     # delete previous highlights, if any
2354     foreach row $boldnamerows {
2355         bolden_name $row mainfont
2356     }
2357     set boldnamerows {}
2358     catch {unset nhighlights}
2359     unbolden
2360     unmarkmatches
2361     if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
2362         set findpattern {}
2363     } elseif {$findtype eq [mc "Regexp"]} {
2364         set findpattern $findstring
2365     } else {
2366         set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2367                    $findstring]
2368         set findpattern "*$e*"
2369     }
2370 }
2371
2372 proc makepatterns {l} {
2373     set ret {}
2374     foreach e $l {
2375         set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2376         if {[string index $ee end] eq "/"} {
2377             lappend ret "$ee*"
2378         } else {
2379             lappend ret $ee
2380             lappend ret "$ee/*"
2381         }
2382     }
2383     return $ret
2384 }
2385
2386 proc do_file_hl {serial} {
2387     global highlight_files filehighlight highlight_paths gdttype fhl_list
2388
2389     if {$gdttype eq [mc "touching paths:"]} {
2390         if {[catch {set paths [shellsplit $highlight_files]}]} return
2391         set highlight_paths [makepatterns $paths]
2392         highlight_filelist
2393         set gdtargs [concat -- $paths]
2394     } elseif {$gdttype eq [mc "adding/removing string:"]} {
2395         set gdtargs [list "-S$highlight_files"]
2396     } else {
2397         # must be "containing:", i.e. we're searching commit info
2398         return
2399     }
2400     set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2401     set filehighlight [open $cmd r+]
2402     fconfigure $filehighlight -blocking 0
2403     filerun $filehighlight readfhighlight
2404     set fhl_list {}
2405     drawvisible
2406     flushhighlights
2407 }
2408
2409 proc flushhighlights {} {
2410     global filehighlight fhl_list
2411
2412     if {[info exists filehighlight]} {
2413         lappend fhl_list {}
2414         puts $filehighlight ""
2415         flush $filehighlight
2416     }
2417 }
2418
2419 proc askfilehighlight {row id} {
2420     global filehighlight fhighlights fhl_list
2421
2422     lappend fhl_list $id
2423     set fhighlights($row) -1
2424     puts $filehighlight $id
2425 }
2426
2427 proc readfhighlight {} {
2428     global filehighlight fhighlights commitrow curview iddrawn
2429     global fhl_list find_dirn
2430
2431     if {![info exists filehighlight]} {
2432         return 0
2433     }
2434     set nr 0
2435     while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2436         set line [string trim $line]
2437         set i [lsearch -exact $fhl_list $line]
2438         if {$i < 0} continue
2439         for {set j 0} {$j < $i} {incr j} {
2440             set id [lindex $fhl_list $j]
2441             if {[info exists commitrow($curview,$id)]} {
2442                 set fhighlights($commitrow($curview,$id)) 0
2443             }
2444         }
2445         set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2446         if {$line eq {}} continue
2447         if {![info exists commitrow($curview,$line)]} continue
2448         set row $commitrow($curview,$line)
2449         if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2450             bolden $row mainfontbold
2451         }
2452         set fhighlights($row) 1
2453     }
2454     if {[eof $filehighlight]} {
2455         # strange...
2456         puts "oops, git diff-tree died"
2457         catch {close $filehighlight}
2458         unset filehighlight
2459         return 0
2460     }
2461     if {[info exists find_dirn]} {
2462         run findmore
2463     }
2464     return 1
2465 }
2466
2467 proc doesmatch {f} {
2468     global findtype findpattern
2469
2470     if {$findtype eq [mc "Regexp"]} {
2471         return [regexp $findpattern $f]
2472     } elseif {$findtype eq [mc "IgnCase"]} {
2473         return [string match -nocase $findpattern $f]
2474     } else {
2475         return [string match $findpattern $f]
2476     }
2477 }
2478
2479 proc askfindhighlight {row id} {
2480     global nhighlights commitinfo iddrawn
2481     global findloc
2482     global markingmatches
2483
2484     if {![info exists commitinfo($id)]} {
2485         getcommit $id
2486     }
2487     set info $commitinfo($id)
2488     set isbold 0
2489     set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
2490     foreach f $info ty $fldtypes {
2491         if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
2492             [doesmatch $f]} {
2493             if {$ty eq [mc "Author"]} {
2494                 set isbold 2
2495                 break
2496             }
2497             set isbold 1
2498         }
2499     }
2500     if {$isbold && [info exists iddrawn($id)]} {
2501         if {![ishighlighted $row]} {
2502             bolden $row mainfontbold
2503             if {$isbold > 1} {
2504                 bolden_name $row mainfontbold
2505             }
2506         }
2507         if {$markingmatches} {
2508             markrowmatches $row $id
2509         }
2510     }
2511     set nhighlights($row) $isbold
2512 }
2513
2514 proc markrowmatches {row id} {
2515     global canv canv2 linehtag linentag commitinfo findloc
2516
2517     set headline [lindex $commitinfo($id) 0]
2518     set author [lindex $commitinfo($id) 1]
2519     $canv delete match$row
2520     $canv2 delete match$row
2521     if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
2522         set m [findmatches $headline]
2523         if {$m ne {}} {
2524             markmatches $canv $row $headline $linehtag($row) $m \
2525                 [$canv itemcget $linehtag($row) -font] $row
2526         }
2527     }
2528     if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
2529         set m [findmatches $author]
2530         if {$m ne {}} {
2531             markmatches $canv2 $row $author $linentag($row) $m \
2532                 [$canv2 itemcget $linentag($row) -font] $row
2533         }
2534     }
2535 }
2536
2537 proc vrel_change {name ix op} {
2538     global highlight_related
2539
2540     rhighlight_none
2541     if {$highlight_related ne [mc "None"]} {
2542         run drawvisible
2543     }
2544 }
2545
2546 # prepare for testing whether commits are descendents or ancestors of a
2547 proc rhighlight_sel {a} {
2548     global descendent desc_todo ancestor anc_todo
2549     global highlight_related rhighlights
2550
2551     catch {unset descendent}
2552     set desc_todo [list $a]
2553     catch {unset ancestor}
2554     set anc_todo [list $a]
2555     if {$highlight_related ne [mc "None"]} {
2556         rhighlight_none
2557         run drawvisible
2558     }
2559 }
2560
2561 proc rhighlight_none {} {
2562     global rhighlights
2563
2564     catch {unset rhighlights}
2565     unbolden
2566 }
2567
2568 proc is_descendent {a} {
2569     global curview children commitrow descendent desc_todo
2570
2571     set v $curview
2572     set la $commitrow($v,$a)
2573     set todo $desc_todo
2574     set leftover {}
2575     set done 0
2576     for {set i 0} {$i < [llength $todo]} {incr i} {
2577         set do [lindex $todo $i]
2578         if {$commitrow($v,$do) < $la} {
2579             lappend leftover $do
2580             continue
2581         }
2582         foreach nk $children($v,$do) {
2583             if {![info exists descendent($nk)]} {
2584                 set descendent($nk) 1
2585                 lappend todo $nk
2586                 if {$nk eq $a} {
2587                     set done 1
2588                 }
2589             }
2590         }
2591         if {$done} {
2592             set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2593             return
2594         }
2595     }
2596     set descendent($a) 0
2597     set desc_todo $leftover
2598 }
2599
2600 proc is_ancestor {a} {
2601     global curview parentlist commitrow ancestor anc_todo
2602
2603     set v $curview
2604     set la $commitrow($v,$a)
2605     set todo $anc_todo
2606     set leftover {}
2607     set done 0
2608     for {set i 0} {$i < [llength $todo]} {incr i} {
2609         set do [lindex $todo $i]
2610         if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2611             lappend leftover $do
2612             continue
2613         }
2614         foreach np [lindex $parentlist $commitrow($v,$do)] {
2615             if {![info exists ancestor($np)]} {
2616                 set ancestor($np) 1
2617                 lappend todo $np
2618                 if {$np eq $a} {
2619                     set done 1
2620                 }
2621             }
2622         }
2623         if {$done} {
2624             set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2625             return
2626         }
2627     }
2628     set ancestor($a) 0
2629     set anc_todo $leftover
2630 }
2631
2632 proc askrelhighlight {row id} {
2633     global descendent highlight_related iddrawn rhighlights
2634     global selectedline ancestor
2635
2636     if {![info exists selectedline]} return
2637     set isbold 0
2638     if {$highlight_related eq [mc "Descendant"] ||
2639         $highlight_related eq [mc "Not descendant"]} {
2640         if {![info exists descendent($id)]} {
2641             is_descendent $id
2642         }
2643         if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
2644             set isbold 1
2645         }
2646     } elseif {$highlight_related eq [mc "Ancestor"] ||
2647               $highlight_related eq [mc "Not ancestor"]} {
2648         if {![info exists ancestor($id)]} {
2649             is_ancestor $id
2650         }
2651         if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
2652             set isbold 1
2653         }
2654     }
2655     if {[info exists iddrawn($id)]} {
2656         if {$isbold && ![ishighlighted $row]} {
2657             bolden $row mainfontbold
2658         }
2659     }
2660     set rhighlights($row) $isbold
2661 }
2662
2663 # Graph layout functions
2664
2665 proc shortids {ids} {
2666     set res {}
2667     foreach id $ids {
2668         if {[llength $id] > 1} {
2669             lappend res [shortids $id]
2670         } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2671             lappend res [string range $id 0 7]
2672         } else {
2673             lappend res $id
2674         }
2675     }
2676     return $res
2677 }
2678
2679 proc ntimes {n o} {
2680     set ret {}
2681     set o [list $o]
2682     for {set mask 1} {$mask <= $n} {incr mask $mask} {
2683         if {($n & $mask) != 0} {
2684             set ret [concat $ret $o]
2685         }
2686         set o [concat $o $o]
2687     }
2688     return $ret
2689 }
2690
2691 # Work out where id should go in idlist so that order-token
2692 # values increase from left to right
2693 proc idcol {idlist id {i 0}} {
2694     global ordertok curview
2695
2696     set t $ordertok($curview,$id)
2697     if {$i >= [llength $idlist] ||
2698         $t < $ordertok($curview,[lindex $idlist $i])} {
2699         if {$i > [llength $idlist]} {
2700             set i [llength $idlist]
2701         }
2702         while {[incr i -1] >= 0 &&
2703                $t < $ordertok($curview,[lindex $idlist $i])} {}
2704         incr i
2705     } else {
2706         if {$t > $ordertok($curview,[lindex $idlist $i])} {
2707             while {[incr i] < [llength $idlist] &&
2708                    $t >= $ordertok($curview,[lindex $idlist $i])} {}
2709         }
2710     }
2711     return $i
2712 }
2713
2714 proc initlayout {} {
2715     global rowidlist rowisopt rowfinal displayorder commitlisted
2716     global numcommits canvxmax canv
2717     global nextcolor
2718     global parentlist
2719     global colormap rowtextx
2720     global selectfirst
2721
2722     set numcommits 0
2723     set displayorder {}
2724     set commitlisted {}
2725     set parentlist {}
2726     set nextcolor 0
2727     set rowidlist {}
2728     set rowisopt {}
2729     set rowfinal {}
2730     set canvxmax [$canv cget -width]
2731     catch {unset colormap}
2732     catch {unset rowtextx}
2733     set selectfirst 1
2734 }
2735
2736 proc setcanvscroll {} {
2737     global canv canv2 canv3 numcommits linespc canvxmax canvy0
2738
2739     set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2740     $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2741     $canv2 conf -scrollregion [list 0 0 0 $ymax]
2742     $canv3 conf -scrollregion [list 0 0 0 $ymax]
2743 }
2744
2745 proc visiblerows {} {
2746     global canv numcommits linespc
2747
2748     set ymax [lindex [$canv cget -scrollregion] 3]
2749     if {$ymax eq {} || $ymax == 0} return
2750     set f [$canv yview]
2751     set y0 [expr {int([lindex $f 0] * $ymax)}]
2752     set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2753     if {$r0 < 0} {
2754         set r0 0
2755     }
2756     set y1 [expr {int([lindex $f 1] * $ymax)}]
2757     set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2758     if {$r1 >= $numcommits} {
2759         set r1 [expr {$numcommits - 1}]
2760     }
2761     return [list $r0 $r1]
2762 }
2763
2764 proc layoutmore {} {
2765     global commitidx viewcomplete numcommits
2766     global uparrowlen downarrowlen mingaplen curview
2767
2768     set show $commitidx($curview)
2769     if {$show > $numcommits || $viewcomplete($curview)} {
2770         showstuff $show $viewcomplete($curview)
2771     }
2772 }
2773
2774 proc showstuff {canshow last} {
2775     global numcommits commitrow pending_select selectedline curview
2776     global mainheadid displayorder selectfirst
2777     global lastscrollset commitinterest
2778
2779     if {$numcommits == 0} {
2780         global phase
2781         set phase "incrdraw"
2782         allcanvs delete all
2783     }
2784     set r0 $numcommits
2785     set prev $numcommits
2786     set numcommits $canshow
2787     set t [clock clicks -milliseconds]
2788     if {$prev < 100 || $last || $t - $lastscrollset > 500} {
2789         set lastscrollset $t
2790         setcanvscroll
2791     }
2792     set rows [visiblerows]
2793     set r1 [lindex $rows 1]
2794     if {$r1 >= $canshow} {
2795         set r1 [expr {$canshow - 1}]
2796     }
2797     if {$r0 <= $r1} {
2798         drawcommits $r0 $r1
2799     }
2800     if {[info exists pending_select] &&
2801         [info exists commitrow($curview,$pending_select)] &&
2802         $commitrow($curview,$pending_select) < $numcommits} {
2803         selectline $commitrow($curview,$pending_select) 1
2804     }
2805     if {$selectfirst} {
2806         if {[info exists selectedline] || [info exists pending_select]} {
2807             set selectfirst 0
2808         } else {
2809             set l [first_real_row]
2810             selectline $l 1
2811             set selectfirst 0
2812         }
2813     }
2814 }
2815
2816 proc doshowlocalchanges {} {
2817     global curview mainheadid phase commitrow
2818
2819     if {[info exists commitrow($curview,$mainheadid)] &&
2820         ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2821         dodiffindex
2822     } elseif {$phase ne {}} {
2823         lappend commitinterest($mainheadid) {}
2824     }
2825 }
2826
2827 proc dohidelocalchanges {} {
2828     global localfrow localirow lserial
2829
2830     if {$localfrow >= 0} {
2831         removerow $localfrow
2832         set localfrow -1
2833         if {$localirow > 0} {
2834             incr localirow -1
2835         }
2836     }
2837     if {$localirow >= 0} {
2838         removerow $localirow
2839         set localirow -1
2840     }
2841     incr lserial
2842 }
2843
2844 # spawn off a process to do git diff-index --cached HEAD
2845 proc dodiffindex {} {
2846     global localirow localfrow lserial showlocalchanges
2847
2848     if {!$showlocalchanges} return
2849     incr lserial
2850     set localfrow -1
2851     set localirow -1
2852     set fd [open "|git diff-index --cached HEAD" r]
2853     fconfigure $fd -blocking 0
2854     filerun $fd [list readdiffindex $fd $lserial]
2855 }
2856
2857 proc readdiffindex {fd serial} {
2858     global localirow commitrow mainheadid nullid2 curview
2859     global commitinfo commitdata lserial
2860
2861     set isdiff 1
2862     if {[gets $fd line] < 0} {
2863         if {![eof $fd]} {
2864             return 1
2865         }
2866         set isdiff 0
2867     }
2868     # we only need to see one line and we don't really care what it says...
2869     close $fd
2870
2871     # now see if there are any local changes not checked in to the index
2872     if {$serial == $lserial} {
2873         set fd [open "|git diff-files" r]
2874         fconfigure $fd -blocking 0
2875         filerun $fd [list readdifffiles $fd $serial]
2876     }
2877
2878     if {$isdiff && $serial == $lserial && $localirow == -1} {
2879         # add the line for the changes in the index to the graph
2880         set localirow $commitrow($curview,$mainheadid)
2881         set hl [mc "Local changes checked in to index but not committed"]
2882         set commitinfo($nullid2) [list  $hl {} {} {} {} "    $hl\n"]
2883         set commitdata($nullid2) "\n    $hl\n"
2884         insertrow $localirow $nullid2
2885     }
2886     return 0
2887 }
2888
2889 proc readdifffiles {fd serial} {
2890     global localirow localfrow commitrow mainheadid nullid curview
2891     global commitinfo commitdata lserial
2892
2893     set isdiff 1
2894     if {[gets $fd line] < 0} {
2895         if {![eof $fd]} {
2896             return 1
2897         }
2898         set isdiff 0
2899     }
2900     # we only need to see one line and we don't really care what it says...
2901     close $fd
2902
2903     if {$isdiff && $serial == $lserial && $localfrow == -1} {
2904         # add the line for the local diff to the graph
2905         if {$localirow >= 0} {
2906             set localfrow $localirow
2907             incr localirow
2908         } else {
2909             set localfrow $commitrow($curview,$mainheadid)
2910         }
2911         set hl [mc "Local uncommitted changes, not checked in to index"]
2912         set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
2913         set commitdata($nullid) "\n    $hl\n"
2914         insertrow $localfrow $nullid
2915     }
2916     return 0
2917 }
2918
2919 proc nextuse {id row} {
2920     global commitrow curview children
2921
2922     if {[info exists children($curview,$id)]} {
2923         foreach kid $children($curview,$id) {
2924             if {![info exists commitrow($curview,$kid)]} {
2925                 return -1
2926             }
2927             if {$commitrow($curview,$kid) > $row} {
2928                 return $commitrow($curview,$kid)
2929             }
2930         }
2931     }
2932     if {[info exists commitrow($curview,$id)]} {
2933         return $commitrow($curview,$id)
2934     }
2935     return -1
2936 }
2937
2938 proc prevuse {id row} {
2939     global commitrow curview children
2940
2941     set ret -1
2942     if {[info exists children($curview,$id)]} {
2943         foreach kid $children($curview,$id) {
2944             if {![info exists commitrow($curview,$kid)]} break
2945             if {$commitrow($curview,$kid) < $row} {
2946                 set ret $commitrow($curview,$kid)
2947             }
2948         }
2949     }
2950     return $ret
2951 }
2952
2953 proc make_idlist {row} {
2954     global displayorder parentlist uparrowlen downarrowlen mingaplen
2955     global commitidx curview ordertok children commitrow
2956
2957     set r [expr {$row - $mingaplen - $downarrowlen - 1}]
2958     if {$r < 0} {
2959         set r 0
2960     }
2961     set ra [expr {$row - $downarrowlen}]
2962     if {$ra < 0} {
2963         set ra 0
2964     }
2965     set rb [expr {$row + $uparrowlen}]
2966     if {$rb > $commitidx($curview)} {
2967         set rb $commitidx($curview)
2968     }
2969     set ids {}
2970     for {} {$r < $ra} {incr r} {
2971         set nextid [lindex $displayorder [expr {$r + 1}]]
2972         foreach p [lindex $parentlist $r] {
2973             if {$p eq $nextid} continue
2974             set rn [nextuse $p $r]
2975             if {$rn >= $row &&
2976                 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
2977                 lappend ids [list $ordertok($curview,$p) $p]
2978             }
2979         }
2980     }
2981     for {} {$r < $row} {incr r} {
2982         set nextid [lindex $displayorder [expr {$r + 1}]]
2983         foreach p [lindex $parentlist $r] {
2984             if {$p eq $nextid} continue
2985             set rn [nextuse $p $r]
2986             if {$rn < 0 || $rn >= $row} {
2987                 lappend ids [list $ordertok($curview,$p) $p]
2988             }
2989         }
2990     }
2991     set id [lindex $displayorder $row]
2992     lappend ids [list $ordertok($curview,$id) $id]
2993     while {$r < $rb} {
2994         foreach p [lindex $parentlist $r] {
2995             set firstkid [lindex $children($curview,$p) 0]
2996             if {$commitrow($curview,$firstkid) < $row} {
2997                 lappend ids [list $ordertok($curview,$p) $p]
2998             }
2999         }
3000         incr r
3001         set id [lindex $displayorder $r]
3002         if {$id ne {}} {
3003             set firstkid [lindex $children($curview,$id) 0]
3004             if {$firstkid ne {} && $commitrow($curview,$firstkid) < $row} {
3005                 lappend ids [list $ordertok($curview,$id) $id]
3006             }
3007         }
3008     }
3009     set idlist {}
3010     foreach idx [lsort -unique $ids] {
3011         lappend idlist [lindex $idx 1]
3012     }
3013     return $idlist
3014 }
3015
3016 proc rowsequal {a b} {
3017     while {[set i [lsearch -exact $a {}]] >= 0} {
3018         set a [lreplace $a $i $i]
3019     }
3020     while {[set i [lsearch -exact $b {}]] >= 0} {
3021         set b [lreplace $b $i $i]
3022     }
3023     return [expr {$a eq $b}]
3024 }
3025
3026 proc makeupline {id row rend col} {
3027     global rowidlist uparrowlen downarrowlen mingaplen
3028
3029     for {set r $rend} {1} {set r $rstart} {
3030         set rstart [prevuse $id $r]
3031         if {$rstart < 0} return
3032         if {$rstart < $row} break
3033     }
3034     if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
3035         set rstart [expr {$rend - $uparrowlen - 1}]
3036     }
3037     for {set r $rstart} {[incr r] <= $row} {} {
3038         set idlist [lindex $rowidlist $r]
3039         if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
3040             set col [idcol $idlist $id $col]
3041             lset rowidlist $r [linsert $idlist $col $id]
3042             changedrow $r
3043         }
3044     }
3045 }
3046
3047 proc layoutrows {row endrow} {
3048     global rowidlist rowisopt rowfinal displayorder
3049     global uparrowlen downarrowlen maxwidth mingaplen
3050     global children parentlist
3051     global commitidx viewcomplete curview commitrow
3052
3053     set idlist {}
3054     if {$row > 0} {
3055         set rm1 [expr {$row - 1}]
3056         foreach id [lindex $rowidlist $rm1] {
3057             if {$id ne {}} {
3058                 lappend idlist $id
3059             }
3060         }
3061         set final [lindex $rowfinal $rm1]
3062     }
3063     for {} {$row < $endrow} {incr row} {
3064         set rm1 [expr {$row - 1}]
3065         if {$rm1 < 0 || $idlist eq {}} {
3066             set idlist [make_idlist $row]
3067             set final 1
3068         } else {
3069             set id [lindex $displayorder $rm1]
3070             set col [lsearch -exact $idlist $id]
3071             set idlist [lreplace $idlist $col $col]
3072             foreach p [lindex $parentlist $rm1] {
3073                 if {[lsearch -exact $idlist $p] < 0} {
3074                     set col [idcol $idlist $p $col]
3075                     set idlist [linsert $idlist $col $p]
3076                     # if not the first child, we have to insert a line going up
3077                     if {$id ne [lindex $children($curview,$p) 0]} {
3078                         makeupline $p $rm1 $row $col
3079                     }
3080                 }
3081             }
3082             set id [lindex $displayorder $row]
3083             if {$row > $downarrowlen} {
3084                 set termrow [expr {$row - $downarrowlen - 1}]
3085                 foreach p [lindex $parentlist $termrow] {
3086                     set i [lsearch -exact $idlist $p]
3087                     if {$i < 0} continue
3088                     set nr [nextuse $p $termrow]
3089                     if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
3090                         set idlist [lreplace $idlist $i $i]
3091                     }
3092                 }
3093             }
3094             set col [lsearch -exact $idlist $id]
3095             if {$col < 0} {
3096                 set col [idcol $idlist $id]
3097                 set idlist [linsert $idlist $col $id]
3098                 if {$children($curview,$id) ne {}} {
3099                     makeupline $id $rm1 $row $col
3100                 }
3101             }
3102             set r [expr {$row + $uparrowlen - 1}]
3103             if {$r < $commitidx($curview)} {
3104                 set x $col
3105                 foreach p [lindex $parentlist $r] {
3106                     if {[lsearch -exact $idlist $p] >= 0} continue
3107                     set fk [lindex $children($curview,$p) 0]
3108                     if {$commitrow($curview,$fk) < $row} {
3109                         set x [idcol $idlist $p $x]
3110                         set idlist [linsert $idlist $x $p]
3111                     }
3112                 }
3113                 if {[incr r] < $commitidx($curview)} {
3114                     set p [lindex $displayorder $r]
3115                     if {[lsearch -exact $idlist $p] < 0} {
3116                         set fk [lindex $children($curview,$p) 0]
3117                         if {$fk ne {} && $commitrow($curview,$fk) < $row} {
3118                             set x [idcol $idlist $p $x]
3119                             set idlist [linsert $idlist $x $p]
3120                         }
3121                     }
3122                 }
3123             }
3124         }
3125         if {$final && !$viewcomplete($curview) &&
3126             $row + $uparrowlen + $mingaplen + $downarrowlen
3127                 >= $commitidx($curview)} {
3128             set final 0
3129         }
3130         set l [llength $rowidlist]
3131         if {$row == $l} {
3132             lappend rowidlist $idlist
3133             lappend rowisopt 0
3134             lappend rowfinal $final
3135         } elseif {$row < $l} {
3136             if {![rowsequal $idlist [lindex $rowidlist $row]]} {
3137                 lset rowidlist $row $idlist
3138                 changedrow $row
3139             }
3140             lset rowfinal $row $final
3141         } else {
3142             set pad [ntimes [expr {$row - $l}] {}]
3143             set rowidlist [concat $rowidlist $pad]
3144             lappend rowidlist $idlist
3145             set rowfinal [concat $rowfinal $pad]
3146             lappend rowfinal $final
3147             set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
3148         }
3149     }
3150     return $row
3151 }
3152
3153 proc changedrow {row} {
3154     global displayorder iddrawn rowisopt need_redisplay
3155
3156     set l [llength $rowisopt]
3157     if {$row < $l} {
3158         lset rowisopt $row 0
3159         if {$row + 1 < $l} {
3160             lset rowisopt [expr {$row + 1}] 0
3161             if {$row + 2 < $l} {
3162                 lset rowisopt [expr {$row + 2}] 0
3163             }
3164         }
3165     }
3166     set id [lindex $displayorder $row]
3167     if {[info exists iddrawn($id)]} {
3168         set need_redisplay 1
3169     }
3170 }
3171
3172 proc insert_pad {row col npad} {
3173     global rowidlist
3174
3175     set pad [ntimes $npad {}]
3176     set idlist [lindex $rowidlist $row]
3177     set bef [lrange $idlist 0 [expr {$col - 1}]]
3178     set aft [lrange $idlist $col end]
3179     set i [lsearch -exact $aft {}]
3180     if {$i > 0} {
3181         set aft [lreplace $aft $i $i]
3182     }
3183     lset rowidlist $row [concat $bef $pad $aft]
3184     changedrow $row
3185 }
3186
3187 proc optimize_rows {row col endrow} {
3188     global rowidlist rowisopt displayorder curview children
3189
3190     if {$row < 1} {
3191         set row 1
3192     }
3193     for {} {$row < $endrow} {incr row; set col 0} {
3194         if {[lindex $rowisopt $row]} continue
3195         set haspad 0
3196         set y0 [expr {$row - 1}]
3197         set ym [expr {$row - 2}]
3198         set idlist [lindex $rowidlist $row]
3199         set previdlist [lindex $rowidlist $y0]
3200         if {$idlist eq {} || $previdlist eq {}} continue
3201         if {$ym >= 0} {
3202             set pprevidlist [lindex $rowidlist $ym]
3203             if {$pprevidlist eq {}} continue
3204         } else {
3205             set pprevidlist {}
3206         }
3207         set x0 -1
3208         set xm -1
3209         for {} {$col < [llength $idlist]} {incr col} {
3210             set id [lindex $idlist $col]
3211             if {[lindex $previdlist $col] eq $id} continue
3212             if {$id eq {}} {
3213                 set haspad 1
3214                 continue
3215             }
3216             set x0 [lsearch -exact $previdlist $id]
3217             if {$x0 < 0} continue
3218             set z [expr {$x0 - $col}]
3219             set isarrow 0
3220             set z0 {}
3221             if {$ym >= 0} {
3222                 set xm [lsearch -exact $pprevidlist $id]
3223                 if {$xm >= 0} {
3224                     set z0 [expr {$xm - $x0}]
3225                 }
3226             }
3227             if {$z0 eq {}} {
3228                 # if row y0 is the first child of $id then it's not an arrow
3229                 if {[lindex $children($curview,$id) 0] ne
3230                     [lindex $displayorder $y0]} {
3231                     set isarrow 1
3232                 }
3233             }
3234             if {!$isarrow && $id ne [lindex $displayorder $row] &&
3235                 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
3236                 set isarrow 1
3237             }
3238             # Looking at lines from this row to the previous row,
3239             # make them go straight up if they end in an arrow on
3240             # the previous row; otherwise make them go straight up
3241             # or at 45 degrees.
3242             if {$z < -1 || ($z < 0 && $isarrow)} {
3243                 # Line currently goes left too much;
3244                 # insert pads in the previous row, then optimize it
3245                 set npad [expr {-1 - $z + $isarrow}]
3246                 insert_pad $y0 $x0 $npad
3247                 if {$y0 > 0} {
3248                     optimize_rows $y0 $x0 $row
3249                 }
3250                 set previdlist [lindex $rowidlist $y0]
3251                 set x0 [lsearch -exact $previdlist $id]
3252                 set z [expr {$x0 - $col}]
3253                 if {$z0 ne {}} {
3254                     set pprevidlist [lindex $rowidlist $ym]
3255                     set xm [lsearch -exact $pprevidlist $id]
3256                     set z0 [expr {$xm - $x0}]
3257                 }
3258             } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3259                 # Line currently goes right too much;
3260                 # insert pads in this line
3261                 set npad [expr {$z - 1 + $isarrow}]
3262                 insert_pad $row $col $npad
3263                 set idlist [lindex $rowidlist $row]
3264                 incr col $npad
3265                 set z [expr {$x0 - $col}]
3266                 set haspad 1
3267             }
3268             if {$z0 eq {} && !$isarrow && $ym >= 0} {
3269                 # this line links to its first child on row $row-2
3270                 set id [lindex $displayorder $ym]
3271                 set xc [lsearch -exact $pprevidlist $id]
3272                 if {$xc >= 0} {
3273                     set z0 [expr {$xc - $x0}]
3274                 }
3275             }
3276             # avoid lines jigging left then immediately right
3277             if {$z0 ne {} && $z < 0 && $z0 > 0} {
3278                 insert_pad $y0 $x0 1
3279                 incr x0
3280                 optimize_rows $y0 $x0 $row
3281                 set previdlist [lindex $rowidlist $y0]
3282             }
3283         }
3284         if {!$haspad} {
3285             # Find the first column that doesn't have a line going right
3286             for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3287                 set id [lindex $idlist $col]
3288                 if {$id eq {}} break
3289                 set x0 [lsearch -exact $previdlist $id]
3290                 if {$x0 < 0} {
3291                     # check if this is the link to the first child
3292                     set kid [lindex $displayorder $y0]
3293                     if {[lindex $children($curview,$id) 0] eq $kid} {
3294                         # it is, work out offset to child
3295                         set x0 [lsearch -exact $previdlist $kid]
3296                     }
3297                 }
3298                 if {$x0 <= $col} break
3299             }
3300             # Insert a pad at that column as long as it has a line and
3301             # isn't the last column
3302             if {$x0 >= 0 && [incr col] < [llength $idlist]} {
3303                 set idlist [linsert $idlist $col {}]
3304                 lset rowidlist $row $idlist
3305                 changedrow $row
3306             }
3307         }
3308     }
3309 }
3310
3311 proc xc {row col} {
3312     global canvx0 linespc
3313     return [expr {$canvx0 + $col * $linespc}]
3314 }
3315
3316 proc yc {row} {
3317     global canvy0 linespc
3318     return [expr {$canvy0 + $row * $linespc}]
3319 }
3320
3321 proc linewidth {id} {
3322     global thickerline lthickness
3323
3324     set wid $lthickness
3325     if {[info exists thickerline] && $id eq $thickerline} {
3326         set wid [expr {2 * $lthickness}]
3327     }
3328     return $wid
3329 }
3330
3331 proc rowranges {id} {
3332     global commitrow curview children uparrowlen downarrowlen
3333     global rowidlist
3334
3335     set kids $children($curview,$id)
3336     if {$kids eq {}} {
3337         return {}
3338     }
3339     set ret {}
3340     lappend kids $id
3341     foreach child $kids {
3342         if {![info exists commitrow($curview,$child)]} break
3343         set row $commitrow($curview,$child)
3344         if {![info exists prev]} {
3345             lappend ret [expr {$row + 1}]
3346         } else {
3347             if {$row <= $prevrow} {
3348                 puts "oops children out of order [shortids $id] $row < [shortids $prev] $prevrow"
3349             }
3350             # see if the line extends the whole way from prevrow to row
3351             if {$row > $prevrow + $uparrowlen + $downarrowlen &&
3352                 [lsearch -exact [lindex $rowidlist \
3353                             [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
3354                 # it doesn't, see where it ends
3355                 set r [expr {$prevrow + $downarrowlen}]
3356                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3357                     while {[incr r -1] > $prevrow &&
3358                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3359                 } else {
3360                     while {[incr r] <= $row &&
3361                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3362                     incr r -1
3363                 }
3364                 lappend ret $r
3365                 # see where it starts up again
3366                 set r [expr {$row - $uparrowlen}]
3367                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3368                     while {[incr r] < $row &&
3369                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3370                 } else {
3371                     while {[incr r -1] >= $prevrow &&
3372                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3373                     incr r
3374                 }
3375                 lappend ret $r
3376             }
3377         }
3378         if {$child eq $id} {
3379             lappend ret $row
3380         }
3381         set prev $id
3382         set prevrow $row
3383     }
3384     return $ret
3385 }
3386
3387 proc drawlineseg {id row endrow arrowlow} {
3388     global rowidlist displayorder iddrawn linesegs
3389     global canv colormap linespc curview maxlinelen parentlist
3390
3391     set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3392     set le [expr {$row + 1}]
3393     set arrowhigh 1
3394     while {1} {
3395         set c [lsearch -exact [lindex $rowidlist $le] $id]
3396         if {$c < 0} {
3397             incr le -1
3398             break
3399         }
3400         lappend cols $c
3401         set x [lindex $displayorder $le]
3402         if {$x eq $id} {
3403             set arrowhigh 0
3404             break
3405         }
3406         if {[info exists iddrawn($x)] || $le == $endrow} {
3407             set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3408             if {$c >= 0} {
3409                 lappend cols $c
3410                 set arrowhigh 0
3411             }
3412             break
3413         }
3414         incr le
3415     }
3416     if {$le <= $row} {
3417         return $row
3418     }
3419
3420     set lines {}
3421     set i 0
3422     set joinhigh 0
3423     if {[info exists linesegs($id)]} {
3424         set lines $linesegs($id)
3425         foreach li $lines {
3426             set r0 [lindex $li 0]
3427             if {$r0 > $row} {
3428                 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3429                     set joinhigh 1
3430                 }
3431                 break
3432             }
3433             incr i
3434         }
3435     }
3436     set joinlow 0
3437     if {$i > 0} {
3438         set li [lindex $lines [expr {$i-1}]]
3439         set r1 [lindex $li 1]
3440         if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3441             set joinlow 1
3442         }
3443     }
3444
3445     set x [lindex $cols [expr {$le - $row}]]
3446     set xp [lindex $cols [expr {$le - 1 - $row}]]
3447     set dir [expr {$xp - $x}]
3448     if {$joinhigh} {
3449         set ith [lindex $lines $i 2]
3450         set coords [$canv coords $ith]
3451         set ah [$canv itemcget $ith -arrow]
3452         set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3453         set x2 [lindex $cols [expr {$le + 1 - $row}]]
3454         if {$x2 ne {} && $x - $x2 == $dir} {
3455             set coords [lrange $coords 0 end-2]
3456         }
3457     } else {
3458         set coords [list [xc $le $x] [yc $le]]
3459     }
3460     if {$joinlow} {
3461         set itl [lindex $lines [expr {$i-1}] 2]
3462         set al [$canv itemcget $itl -arrow]
3463         set arrowlow [expr {$al eq "last" || $al eq "both"}]
3464     } elseif {$arrowlow} {
3465         if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
3466             [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
3467             set arrowlow 0
3468         }
3469     }
3470     set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3471     for {set y $le} {[incr y -1] > $row} {} {
3472         set x $xp
3473         set xp [lindex $cols [expr {$y - 1 - $row}]]
3474         set ndir [expr {$xp - $x}]
3475         if {$dir != $ndir || $xp < 0} {
3476             lappend coords [xc $y $x] [yc $y]
3477         }
3478         set dir $ndir
3479     }
3480     if {!$joinlow} {
3481         if {$xp < 0} {
3482             # join parent line to first child
3483             set ch [lindex $displayorder $row]
3484             set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3485             if {$xc < 0} {
3486                 puts "oops: drawlineseg: child $ch not on row $row"
3487             } elseif {$xc != $x} {
3488                 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
3489                     set d [expr {int(0.5 * $linespc)}]
3490                     set x1 [xc $row $x]
3491                     if {$xc < $x} {
3492                         set x2 [expr {$x1 - $d}]
3493                     } else {
3494                         set x2 [expr {$x1 + $d}]
3495                     }
3496                     set y2 [yc $row]
3497                     set y1 [expr {$y2 + $d}]
3498                     lappend coords $x1 $y1 $x2 $y2
3499                 } elseif {$xc < $x - 1} {
3500                     lappend coords [xc $row [expr {$x-1}]] [yc $row]
3501                 } elseif {$xc > $x + 1} {
3502                     lappend coords [xc $row [expr {$x+1}]] [yc $row]
3503                 }
3504                 set x $xc
3505             }
3506             lappend coords [xc $row $x] [yc $row]
3507         } else {
3508             set xn [xc $row $xp]
3509             set yn [yc $row]
3510             lappend coords $xn $yn
3511         }
3512         if {!$joinhigh} {
3513             assigncolor $id
3514             set t [$canv create line $coords -width [linewidth $id] \
3515                        -fill $colormap($id) -tags lines.$id -arrow $arrow]
3516             $canv lower $t
3517             bindline $t $id
3518             set lines [linsert $lines $i [list $row $le $t]]
3519         } else {
3520             $canv coords $ith $coords
3521             if {$arrow ne $ah} {
3522                 $canv itemconf $ith -arrow $arrow
3523             }
3524             lset lines $i 0 $row
3525         }
3526     } else {
3527         set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3528         set ndir [expr {$xo - $xp}]
3529         set clow [$canv coords $itl]
3530         if {$dir == $ndir} {
3531             set clow [lrange $clow 2 end]
3532         }
3533         set coords [concat $coords $clow]
3534         if {!$joinhigh} {
3535             lset lines [expr {$i-1}] 1 $le
3536         } else {
3537             # coalesce two pieces
3538             $canv delete $ith
3539             set b [lindex $lines [expr {$i-1}] 0]
3540             set e [lindex $lines $i 1]
3541             set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3542         }
3543         $canv coords $itl $coords
3544         if {$arrow ne $al} {
3545             $canv itemconf $itl -arrow $arrow
3546         }
3547     }
3548
3549     set linesegs($id) $lines
3550     return $le
3551 }
3552
3553 proc drawparentlinks {id row} {
3554     global rowidlist canv colormap curview parentlist
3555     global idpos linespc
3556
3557     set rowids [lindex $rowidlist $row]
3558     set col [lsearch -exact $rowids $id]
3559     if {$col < 0} return
3560     set olds [lindex $parentlist $row]
3561     set row2 [expr {$row + 1}]
3562     set x [xc $row $col]
3563     set y [yc $row]
3564     set y2 [yc $row2]
3565     set d [expr {int(0.5 * $linespc)}]
3566     set ymid [expr {$y + $d}]
3567     set ids [lindex $rowidlist $row2]
3568     # rmx = right-most X coord used
3569     set rmx 0
3570     foreach p $olds {
3571         set i [lsearch -exact $ids $p]
3572         if {$i < 0} {
3573             puts "oops, parent $p of $id not in list"
3574             continue
3575         }
3576         set x2 [xc $row2 $i]
3577         if {$x2 > $rmx} {
3578             set rmx $x2
3579         }
3580         set j [lsearch -exact $rowids $p]
3581         if {$j < 0} {
3582             # drawlineseg will do this one for us
3583             continue
3584         }
3585         assigncolor $p
3586         # should handle duplicated parents here...
3587         set coords [list $x $y]
3588         if {$i != $col} {
3589             # if attaching to a vertical segment, draw a smaller
3590             # slant for visual distinctness
3591             if {$i == $j} {
3592                 if {$i < $col} {
3593                     lappend coords [expr {$x2 + $d}] $y $x2 $ymid
3594                 } else {
3595                     lappend coords [expr {$x2 - $d}] $y $x2 $ymid
3596                 }
3597             } elseif {$i < $col && $i < $j} {
3598                 # segment slants towards us already
3599                 lappend coords [xc $row $j] $y
3600             } else {
3601                 if {$i < $col - 1} {
3602                     lappend coords [expr {$x2 + $linespc}] $y
3603                 } elseif {$i > $col + 1} {
3604                     lappend coords [expr {$x2 - $linespc}] $y
3605                 }
3606                 lappend coords $x2 $y2
3607             }
3608         } else {
3609             lappend coords $x2 $y2
3610         }
3611         set t [$canv create line $coords -width [linewidth $p] \
3612                    -fill $colormap($p) -tags lines.$p]
3613         $canv lower $t
3614         bindline $t $p
3615     }
3616     if {$rmx > [lindex $idpos($id) 1]} {
3617         lset idpos($id) 1 $rmx
3618         redrawtags $id
3619     }
3620 }
3621
3622 proc drawlines {id} {
3623     global canv
3624
3625     $canv itemconf lines.$id -width [linewidth $id]
3626 }
3627
3628 proc drawcmittext {id row col} {
3629     global linespc canv canv2 canv3 canvy0 fgcolor curview
3630     global commitlisted commitinfo rowidlist parentlist
3631     global rowtextx idpos idtags idheads idotherrefs
3632     global linehtag linentag linedtag selectedline
3633     global canvxmax boldrows boldnamerows fgcolor nullid nullid2
3634
3635     # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
3636     set listed [lindex $commitlisted $row]
3637     if {$id eq $nullid} {
3638         set ofill red
3639     } elseif {$id eq $nullid2} {
3640         set ofill green
3641     } else {
3642         set ofill [expr {$listed != 0 ? $listed == 2 ? "gray" : "blue" : "white"}]
3643     }
3644     set x [xc $row $col]
3645     set y [yc $row]
3646     set orad [expr {$linespc / 3}]
3647     if {$listed <= 2} {
3648         set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3649                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3650                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
3651     } elseif {$listed == 3} {
3652         # triangle pointing left for left-side commits
3653         set t [$canv create polygon \
3654                    [expr {$x - $orad}] $y \
3655                    [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3656                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3657                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
3658     } else {
3659         # triangle pointing right for right-side commits
3660         set t [$canv create polygon \
3661                    [expr {$x + $orad - 1}] $y \
3662                    [expr {$x - $orad}] [expr {$y - $orad}] \
3663                    [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3664                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
3665     }
3666     $canv raise $t
3667     $canv bind $t <1> {selcanvline {} %x %y}
3668     set rmx [llength [lindex $rowidlist $row]]
3669     set olds [lindex $parentlist $row]
3670     if {$olds ne {}} {
3671         set nextids [lindex $rowidlist [expr {$row + 1}]]
3672         foreach p $olds {
3673             set i [lsearch -exact $nextids $p]
3674             if {$i > $rmx} {
3675                 set rmx $i
3676             }
3677         }
3678     }
3679     set xt [xc $row $rmx]
3680     set rowtextx($row) $xt
3681     set idpos($id) [list $x $xt $y]
3682     if {[info exists idtags($id)] || [info exists idheads($id)]
3683         || [info exists idotherrefs($id)]} {
3684         set xt [drawtags $id $x $xt $y]
3685     }
3686     set headline [lindex $commitinfo($id) 0]
3687     set name [lindex $commitinfo($id) 1]
3688     set date [lindex $commitinfo($id) 2]
3689     set date [formatdate $date]
3690     set font mainfont
3691     set nfont mainfont
3692     set isbold [ishighlighted $row]
3693     if {$isbold > 0} {
3694         lappend boldrows $row
3695         set font mainfontbold
3696         if {$isbold > 1} {
3697             lappend boldnamerows $row
3698             set nfont mainfontbold
3699         }
3700     }
3701     set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3702                             -text $headline -font $font -tags text]
3703     $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3704     set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3705                             -text $name -font $nfont -tags text]
3706     set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3707                             -text $date -font mainfont -tags text]
3708     if {[info exists selectedline] && $selectedline == $row} {
3709         make_secsel $row
3710     }
3711     set xr [expr {$xt + [font measure $font $headline]}]
3712     if {$xr > $canvxmax} {
3713         set canvxmax $xr
3714         setcanvscroll
3715     }
3716 }
3717
3718 proc drawcmitrow {row} {
3719     global displayorder rowidlist nrows_drawn
3720     global iddrawn markingmatches
3721     global commitinfo parentlist numcommits
3722     global filehighlight fhighlights findpattern nhighlights
3723     global hlview vhighlights
3724     global highlight_related rhighlights
3725
3726     if {$row >= $numcommits} return
3727
3728     set id [lindex $displayorder $row]
3729     if {[info exists hlview] && ![info exists vhighlights($row)]} {
3730         askvhighlight $row $id
3731     }
3732     if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3733         askfilehighlight $row $id
3734     }
3735     if {$findpattern ne {} && ![info exists nhighlights($row)]} {
3736         askfindhighlight $row $id
3737     }
3738     if {$highlight_related ne [mc "None"] && ![info exists rhighlights($row)]} {
3739         askrelhighlight $row $id
3740     }
3741     if {![info exists iddrawn($id)]} {
3742         set col [lsearch -exact [lindex $rowidlist $row] $id]
3743         if {$col < 0} {
3744             puts "oops, row $row id $id not in list"
3745             return
3746         }
3747         if {![info exists commitinfo($id)]} {
3748             getcommit $id
3749         }
3750         assigncolor $id
3751         drawcmittext $id $row $col
3752         set iddrawn($id) 1
3753         incr nrows_drawn
3754     }
3755     if {$markingmatches} {
3756         markrowmatches $row $id
3757     }
3758 }
3759
3760 proc drawcommits {row {endrow {}}} {
3761     global numcommits iddrawn displayorder curview need_redisplay
3762     global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
3763
3764     if {$row < 0} {
3765         set row 0
3766     }
3767     if {$endrow eq {}} {
3768         set endrow $row
3769     }
3770     if {$endrow >= $numcommits} {
3771         set endrow [expr {$numcommits - 1}]
3772     }
3773
3774     set rl1 [expr {$row - $downarrowlen - 3}]
3775     if {$rl1 < 0} {
3776         set rl1 0
3777     }
3778     set ro1 [expr {$row - 3}]
3779     if {$ro1 < 0} {
3780         set ro1 0
3781     }
3782     set r2 [expr {$endrow + $uparrowlen + 3}]
3783     if {$r2 > $numcommits} {
3784         set r2 $numcommits
3785     }
3786     for {set r $rl1} {$r < $r2} {incr r} {
3787         if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
3788             if {$rl1 < $r} {
3789                 layoutrows $rl1 $r
3790             }
3791             set rl1 [expr {$r + 1}]
3792         }
3793     }
3794     if {$rl1 < $r} {
3795         layoutrows $rl1 $r
3796     }
3797     optimize_rows $ro1 0 $r2
3798     if {$need_redisplay || $nrows_drawn > 2000} {
3799         clear_display
3800         drawvisible
3801     }
3802
3803     # make the lines join to already-drawn rows either side
3804     set r [expr {$row - 1}]
3805     if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3806         set r $row
3807     }
3808     set er [expr {$endrow + 1}]
3809     if {$er >= $numcommits ||
3810         ![info exists iddrawn([lindex $displayorder $er])]} {
3811         set er $endrow
3812     }
3813     for {} {$r <= $er} {incr r} {
3814         set id [lindex $displayorder $r]
3815         set wasdrawn [info exists iddrawn($id)]
3816         drawcmitrow $r
3817         if {$r == $er} break
3818         set nextid [lindex $displayorder [expr {$r + 1}]]
3819         if {$wasdrawn && [info exists iddrawn($nextid)]} continue
3820         drawparentlinks $id $r
3821
3822         set rowids [lindex $rowidlist $r]
3823         foreach lid $rowids {
3824             if {$lid eq {}} continue
3825             if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
3826             if {$lid eq $id} {
3827                 # see if this is the first child of any of its parents
3828                 foreach p [lindex $parentlist $r] {
3829                     if {[lsearch -exact $rowids $p] < 0} {
3830                         # make this line extend up to the child
3831                         set lineend($p) [drawlineseg $p $r $er 0]
3832                     }
3833                 }
3834             } else {
3835                 set lineend($lid) [drawlineseg $lid $r $er 1]
3836             }
3837         }
3838     }
3839 }
3840
3841 proc drawfrac {f0 f1} {
3842     global canv linespc
3843
3844     set ymax [lindex [$canv cget -scrollregion] 3]
3845     if {$ymax eq {} || $ymax == 0} return
3846     set y0 [expr {int($f0 * $ymax)}]
3847     set row [expr {int(($y0 - 3) / $linespc) - 1}]
3848     set y1 [expr {int($f1 * $ymax)}]
3849     set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3850     drawcommits $row $endrow
3851 }
3852
3853 proc drawvisible {} {
3854     global canv
3855     eval drawfrac [$canv yview]
3856 }
3857
3858 proc clear_display {} {
3859     global iddrawn linesegs need_redisplay nrows_drawn
3860     global vhighlights fhighlights nhighlights rhighlights
3861
3862     allcanvs delete all
3863     catch {unset iddrawn}
3864     catch {unset linesegs}
3865     catch {unset vhighlights}
3866     catch {unset fhighlights}
3867     catch {unset nhighlights}
3868     catch {unset rhighlights}
3869     set need_redisplay 0
3870     set nrows_drawn 0
3871 }
3872
3873 proc findcrossings {id} {
3874     global rowidlist parentlist numcommits displayorder
3875
3876     set cross {}
3877     set ccross {}
3878     foreach {s e} [rowranges $id] {
3879         if {$e >= $numcommits} {
3880             set e [expr {$numcommits - 1}]
3881         }
3882         if {$e <= $s} continue
3883         for {set row $e} {[incr row -1] >= $s} {} {
3884             set x [lsearch -exact [lindex $rowidlist $row] $id]
3885             if {$x < 0} break
3886             set olds [lindex $parentlist $row]
3887             set kid [lindex $displayorder $row]
3888             set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3889             if {$kidx < 0} continue
3890             set nextrow [lindex $rowidlist [expr {$row + 1}]]
3891             foreach p $olds {
3892                 set px [lsearch -exact $nextrow $p]
3893                 if {$px < 0} continue
3894                 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3895                     if {[lsearch -exact $ccross $p] >= 0} continue
3896                     if {$x == $px + ($kidx < $px? -1: 1)} {
3897                         lappend ccross $p
3898                     } elseif {[lsearch -exact $cross $p] < 0} {
3899                         lappend cross $p
3900                     }
3901                 }
3902             }
3903         }
3904     }
3905     return [concat $ccross {{}} $cross]
3906 }
3907
3908 proc assigncolor {id} {
3909     global colormap colors nextcolor
3910     global commitrow parentlist children children curview
3911
3912     if {[info exists colormap($id)]} return
3913     set ncolors [llength $colors]
3914     if {[info exists children($curview,$id)]} {
3915         set kids $children($curview,$id)
3916     } else {
3917         set kids {}
3918     }
3919     if {[llength $kids] == 1} {
3920         set child [lindex $kids 0]
3921         if {[info exists colormap($child)]
3922             && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3923             set colormap($id) $colormap($child)
3924             return
3925         }
3926     }
3927     set badcolors {}
3928     set origbad {}
3929     foreach x [findcrossings $id] {
3930         if {$x eq {}} {
3931             # delimiter between corner crossings and other crossings
3932             if {[llength $badcolors] >= $ncolors - 1} break
3933             set origbad $badcolors
3934         }
3935         if {[info exists colormap($x)]
3936             && [lsearch -exact $badcolors $colormap($x)] < 0} {
3937             lappend badcolors $colormap($x)
3938         }
3939     }
3940     if {[llength $badcolors] >= $ncolors} {
3941         set badcolors $origbad
3942     }
3943     set origbad $badcolors
3944     if {[llength $badcolors] < $ncolors - 1} {
3945         foreach child $kids {
3946             if {[info exists colormap($child)]
3947                 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3948                 lappend badcolors $colormap($child)
3949             }
3950             foreach p [lindex $parentlist $commitrow($curview,$child)] {
3951                 if {[info exists colormap($p)]
3952                     && [lsearch -exact $badcolors $colormap($p)] < 0} {
3953                     lappend badcolors $colormap($p)
3954                 }
3955             }
3956         }
3957         if {[llength $badcolors] >= $ncolors} {
3958             set badcolors $origbad
3959         }
3960     }
3961     for {set i 0} {$i <= $ncolors} {incr i} {
3962         set c [lindex $colors $nextcolor]
3963         if {[incr nextcolor] >= $ncolors} {
3964             set nextcolor 0
3965         }
3966         if {[lsearch -exact $badcolors $c]} break
3967     }
3968     set colormap($id) $c
3969 }
3970
3971 proc bindline {t id} {
3972     global canv
3973
3974     $canv bind $t <Enter> "lineenter %x %y $id"
3975     $canv bind $t <Motion> "linemotion %x %y $id"
3976     $canv bind $t <Leave> "lineleave $id"
3977     $canv bind $t <Button-1> "lineclick %x %y $id 1"
3978 }
3979
3980 proc drawtags {id x xt y1} {
3981     global idtags idheads idotherrefs mainhead
3982     global linespc lthickness
3983     global canv commitrow rowtextx curview fgcolor bgcolor
3984
3985     set marks {}
3986     set ntags 0
3987     set nheads 0
3988     if {[info exists idtags($id)]} {
3989         set marks $idtags($id)
3990         set ntags [llength $marks]
3991     }
3992     if {[info exists idheads($id)]} {
3993         set marks [concat $marks $idheads($id)]
3994         set nheads [llength $idheads($id)]
3995     }
3996     if {[info exists idotherrefs($id)]} {
3997         set marks [concat $marks $idotherrefs($id)]
3998     }
3999     if {$marks eq {}} {
4000         return $xt
4001     }
4002
4003     set delta [expr {int(0.5 * ($linespc - $lthickness))}]
4004     set yt [expr {$y1 - 0.5 * $linespc}]
4005     set yb [expr {$yt + $linespc - 1}]
4006     set xvals {}
4007     set wvals {}
4008     set i -1
4009     foreach tag $marks {
4010         incr i
4011         if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
4012             set wid [font measure mainfontbold $tag]
4013         } else {
4014             set wid [font measure mainfont $tag]
4015         }
4016         lappend xvals $xt
4017         lappend wvals $wid
4018         set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
4019     }
4020     set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
4021                -width $lthickness -fill black -tags tag.$id]
4022     $canv lower $t
4023     foreach tag $marks x $xvals wid $wvals {
4024         set xl [expr {$x + $delta}]
4025         set xr [expr {$x + $delta + $wid + $lthickness}]
4026         set font mainfont
4027         if {[incr ntags -1] >= 0} {
4028             # draw a tag
4029             set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
4030                        $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
4031                        -width 1 -outline black -fill yellow -tags tag.$id]
4032             $canv bind $t <1> [list showtag $tag 1]
4033             set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
4034         } else {
4035             # draw a head or other ref
4036             if {[incr nheads -1] >= 0} {
4037                 set col green
4038                 if {$tag eq $mainhead} {
4039                     set font mainfontbold
4040                 }
4041             } else {
4042                 set col "#ddddff"
4043             }
4044             set xl [expr {$xl - $delta/2}]
4045             $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
4046                 -width 1 -outline black -fill $col -tags tag.$id
4047             if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
4048                 set rwid [font measure mainfont $remoteprefix]
4049                 set xi [expr {$x + 1}]
4050                 set yti [expr {$yt + 1}]
4051                 set xri [expr {$x + $rwid}]
4052                 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
4053                         -width 0 -fill "#ffddaa" -tags tag.$id
4054             }
4055         }
4056         set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
4057                    -font $font -tags [list tag.$id text]]
4058         if {$ntags >= 0} {
4059             $canv bind $t <1> [list showtag $tag 1]
4060         } elseif {$nheads >= 0} {
4061             $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
4062         }
4063     }
4064     return $xt
4065 }
4066
4067 proc xcoord {i level ln} {
4068     global canvx0 xspc1 xspc2
4069
4070     set x [expr {$canvx0 + $i * $xspc1($ln)}]
4071     if {$i > 0 && $i == $level} {
4072         set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
4073     } elseif {$i > $level} {
4074         set x [expr {$x + $xspc2 - $xspc1($ln)}]
4075     }
4076     return $x
4077 }
4078
4079 proc show_status {msg} {
4080     global canv fgcolor
4081
4082     clear_display
4083     $canv create text 3 3 -anchor nw -text $msg -font mainfont \
4084         -tags text -fill $fgcolor
4085 }
4086
4087 # Insert a new commit as the child of the commit on row $row.
4088 # The new commit will be displayed on row $row and the commits
4089 # on that row and below will move down one row.
4090 proc insertrow {row newcmit} {
4091     global displayorder parentlist commitlisted children
4092     global commitrow curview rowidlist rowisopt rowfinal numcommits
4093     global numcommits
4094     global selectedline commitidx ordertok
4095
4096     if {$row >= $numcommits} {
4097         puts "oops, inserting new row $row but only have $numcommits rows"
4098         return
4099     }
4100     set p [lindex $displayorder $row]
4101     set displayorder [linsert $displayorder $row $newcmit]
4102     set parentlist [linsert $parentlist $row $p]
4103     set kids $children($curview,$p)
4104     lappend kids $newcmit
4105     set children($curview,$p) $kids
4106     set children($curview,$newcmit) {}
4107     set commitlisted [linsert $commitlisted $row 1]
4108     set l [llength $displayorder]
4109     for {set r $row} {$r < $l} {incr r} {
4110         set id [lindex $displayorder $r]
4111         set commitrow($curview,$id) $r
4112     }
4113     incr commitidx($curview)
4114     set ordertok($curview,$newcmit) $ordertok($curview,$p)
4115
4116     if {$row < [llength $rowidlist]} {
4117         set idlist [lindex $rowidlist $row]
4118         if {$idlist ne {}} {
4119             if {[llength $kids] == 1} {
4120                 set col [lsearch -exact $idlist $p]
4121                 lset idlist $col $newcmit
4122             } else {
4123                 set col [llength $idlist]
4124                 lappend idlist $newcmit
4125             }
4126         }
4127         set rowidlist [linsert $rowidlist $row $idlist]
4128         set rowisopt [linsert $rowisopt $row 0]
4129         set rowfinal [linsert $rowfinal $row [lindex $rowfinal $row]]
4130     }
4131
4132     incr numcommits
4133
4134     if {[info exists selectedline] && $selectedline >= $row} {
4135         incr selectedline
4136     }
4137     redisplay
4138 }
4139
4140 # Remove a commit that was inserted with insertrow on row $row.
4141 proc removerow {row} {
4142     global displayorder parentlist commitlisted children
4143     global commitrow curview rowidlist rowisopt rowfinal numcommits
4144     global numcommits
4145     global linesegends selectedline commitidx
4146
4147     if {$row >= $numcommits} {
4148         puts "oops, removing row $row but only have $numcommits rows"
4149         return
4150     }
4151     set rp1 [expr {$row + 1}]
4152     set id [lindex $displayorder $row]
4153     set p [lindex $parentlist $row]
4154     set displayorder [lreplace $displayorder $row $row]
4155     set parentlist [lreplace $parentlist $row $row]
4156     set commitlisted [lreplace $commitlisted $row $row]
4157     set kids $children($curview,$p)
4158     set i [lsearch -exact $kids $id]
4159     if {$i >= 0} {
4160         set kids [lreplace $kids $i $i]
4161         set children($curview,$p) $kids
4162     }
4163     set l [llength $displayorder]
4164     for {set r $row} {$r < $l} {incr r} {
4165         set id [lindex $displayorder $r]
4166         set commitrow($curview,$id) $r
4167     }
4168     incr commitidx($curview) -1
4169
4170     if {$row < [llength $rowidlist]} {
4171         set rowidlist [lreplace $rowidlist $row $row]
4172         set rowisopt [lreplace $rowisopt $row $row]
4173         set rowfinal [lreplace $rowfinal $row $row]
4174     }
4175
4176     incr numcommits -1
4177
4178     if {[info exists selectedline] && $selectedline > $row} {
4179         incr selectedline -1
4180     }
4181     redisplay
4182 }
4183
4184 # Don't change the text pane cursor if it is currently the hand cursor,
4185 # showing that we are over a sha1 ID link.
4186 proc settextcursor {c} {
4187     global ctext curtextcursor
4188
4189     if {[$ctext cget -cursor] == $curtextcursor} {
4190         $ctext config -cursor $c
4191     }
4192     set curtextcursor $c
4193 }
4194
4195 proc nowbusy {what {name {}}} {
4196     global isbusy busyname statusw
4197
4198     if {[array names isbusy] eq {}} {
4199         . config -cursor watch
4200         settextcursor watch
4201     }
4202     set isbusy($what) 1
4203     set busyname($what) $name
4204     if {$name ne {}} {
4205         $statusw conf -text $name
4206     }
4207 }
4208
4209 proc notbusy {what} {
4210     global isbusy maincursor textcursor busyname statusw
4211
4212     catch {
4213         unset isbusy($what)
4214         if {$busyname($what) ne {} &&
4215             [$statusw cget -text] eq $busyname($what)} {
4216             $statusw conf -text {}
4217         }
4218     }
4219     if {[array names isbusy] eq {}} {
4220         . config -cursor $maincursor
4221         settextcursor $textcursor
4222     }
4223 }
4224
4225 proc findmatches {f} {
4226     global findtype findstring
4227     if {$findtype == [mc "Regexp"]} {
4228         set matches [regexp -indices -all -inline $findstring $f]
4229     } else {
4230         set fs $findstring
4231         if {$findtype == [mc "IgnCase"]} {
4232             set f [string tolower $f]
4233             set fs [string tolower $fs]
4234         }
4235         set matches {}
4236         set i 0
4237         set l [string length $fs]
4238         while {[set j [string first $fs $f $i]] >= 0} {
4239             lappend matches [list $j [expr {$j+$l-1}]]
4240             set i [expr {$j + $l}]
4241         }
4242     }
4243     return $matches
4244 }
4245
4246 proc dofind {{dirn 1} {wrap 1}} {
4247     global findstring findstartline findcurline selectedline numcommits
4248     global gdttype filehighlight fh_serial find_dirn findallowwrap
4249
4250     if {[info exists find_dirn]} {
4251         if {$find_dirn == $dirn} return
4252         stopfinding
4253     }
4254     focus .
4255     if {$findstring eq {} || $numcommits == 0} return
4256     if {![info exists selectedline]} {
4257         set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
4258     } else {
4259         set findstartline $selectedline
4260     }
4261     set findcurline $findstartline
4262     nowbusy finding [mc "Searching"]
4263     if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
4264         after cancel do_file_hl $fh_serial
4265         do_file_hl $fh_serial
4266     }
4267     set find_dirn $dirn
4268     set findallowwrap $wrap
4269     run findmore
4270 }
4271
4272 proc stopfinding {} {
4273     global find_dirn findcurline fprogcoord
4274
4275     if {[info exists find_dirn]} {
4276         unset find_dirn
4277         unset findcurline
4278         notbusy finding
4279         set fprogcoord 0
4280         adjustprogress
4281     }
4282 }
4283
4284 proc findmore {} {
4285     global commitdata commitinfo numcommits findpattern findloc
4286     global findstartline findcurline displayorder
4287     global find_dirn gdttype fhighlights fprogcoord
4288     global findallowwrap
4289
4290     if {![info exists find_dirn]} {
4291         return 0
4292     }
4293     set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
4294     set l $findcurline
4295     set moretodo 0
4296     if {$find_dirn > 0} {
4297         incr l
4298         if {$l >= $numcommits} {
4299             set l 0
4300         }
4301         if {$l <= $findstartline} {
4302             set lim [expr {$findstartline + 1}]
4303         } else {
4304             set lim $numcommits
4305             set moretodo $findallowwrap
4306         }
4307     } else {
4308         if {$l == 0} {
4309             set l $numcommits
4310         }
4311         incr l -1
4312         if {$l >= $findstartline} {
4313             set lim [expr {$findstartline - 1}]
4314         } else {
4315             set lim -1
4316             set moretodo $findallowwrap
4317         }
4318     }
4319     set n [expr {($lim - $l) * $find_dirn}]
4320     if {$n > 500} {
4321         set n 500
4322         set moretodo 1
4323     }
4324     set found 0
4325     set domore 1
4326     if {$gdttype eq [mc "containing:"]} {
4327         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
4328             set id [lindex $displayorder $l]
4329             # shouldn't happen unless git log doesn't give all the commits...
4330             if {![info exists commitdata($id)]} continue
4331             if {![doesmatch $commitdata($id)]} continue
4332             if {![info exists commitinfo($id)]} {
4333                 getcommit $id
4334             }
4335             set info $commitinfo($id)
4336             foreach f $info ty $fldtypes {
4337                 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4338                     [doesmatch $f]} {
4339                     set found 1
4340                     break
4341                 }
4342             }
4343             if {$found} break
4344         }
4345     } else {
4346         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
4347             set id [lindex $displayorder $l]
4348             if {![info exists fhighlights($l)]} {
4349                 askfilehighlight $l $id
4350                 if {$domore} {
4351                     set domore 0
4352                     set findcurline [expr {$l - $find_dirn}]
4353                 }
4354             } elseif {$fhighlights($l)} {
4355                 set found $domore
4356                 break
4357             }
4358         }
4359     }
4360     if {$found || ($domore && !$moretodo)} {
4361         unset findcurline
4362         unset find_dirn
4363         notbusy finding
4364         set fprogcoord 0
4365         adjustprogress
4366         if {$found} {
4367             findselectline $l
4368         } else {
4369             bell
4370         }
4371         return 0
4372     }
4373     if {!$domore} {
4374         flushhighlights
4375     } else {
4376         set findcurline [expr {$l - $find_dirn}]
4377     }
4378     set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
4379     if {$n < 0} {
4380         incr n $numcommits
4381     }
4382     set fprogcoord [expr {$n * 1.0 / $numcommits}]
4383     adjustprogress
4384     return $domore
4385 }
4386
4387 proc findselectline {l} {
4388     global findloc commentend ctext findcurline markingmatches gdttype
4389
4390     set markingmatches 1
4391     set findcurline $l
4392     selectline $l 1
4393     if {$findloc == [mc "All fields"] || $findloc == [mc "Comments"]} {
4394         # highlight the matches in the comments
4395         set f [$ctext get 1.0 $commentend]
4396         set matches [findmatches $f]
4397         foreach match $matches {
4398             set start [lindex $match 0]
4399             set end [expr {[lindex $match 1] + 1}]
4400             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4401         }
4402     }
4403     drawvisible
4404 }
4405
4406 # mark the bits of a headline or author that match a find string
4407 proc markmatches {canv l str tag matches font row} {
4408     global selectedline
4409
4410     set bbox [$canv bbox $tag]
4411     set x0 [lindex $bbox 0]
4412     set y0 [lindex $bbox 1]
4413     set y1 [lindex $bbox 3]
4414     foreach match $matches {
4415         set start [lindex $match 0]
4416         set end [lindex $match 1]
4417         if {$start > $end} continue
4418         set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4419         set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4420         set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4421                    [expr {$x0+$xlen+2}] $y1 \
4422                    -outline {} -tags [list match$l matches] -fill yellow]
4423         $canv lower $t
4424         if {[info exists selectedline] && $row == $selectedline} {
4425             $canv raise $t secsel
4426         }
4427     }
4428 }
4429
4430 proc unmarkmatches {} {
4431     global markingmatches
4432
4433     allcanvs delete matches
4434     set markingmatches 0
4435     stopfinding
4436 }
4437
4438 proc selcanvline {w x y} {
4439     global canv canvy0 ctext linespc
4440     global rowtextx
4441     set ymax [lindex [$canv cget -scrollregion] 3]
4442     if {$ymax == {}} return
4443     set yfrac [lindex [$canv yview] 0]
4444     set y [expr {$y + $yfrac * $ymax}]
4445     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4446     if {$l < 0} {
4447         set l 0
4448     }
4449     if {$w eq $canv} {
4450         if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4451     }
4452     unmarkmatches
4453     selectline $l 1
4454 }
4455
4456 proc commit_descriptor {p} {
4457     global commitinfo
4458     if {![info exists commitinfo($p)]} {
4459         getcommit $p
4460     }
4461     set l "..."
4462     if {[llength $commitinfo($p)] > 1} {
4463         set l [lindex $commitinfo($p) 0]
4464     }
4465     return "$p ($l)\n"
4466 }
4467
4468 # append some text to the ctext widget, and make any SHA1 ID
4469 # that we know about be a clickable link.
4470 proc appendwithlinks {text tags} {
4471     global ctext commitrow linknum curview pendinglinks
4472
4473     set start [$ctext index "end - 1c"]
4474     $ctext insert end $text $tags
4475     set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4476     foreach l $links {
4477         set s [lindex $l 0]
4478         set e [lindex $l 1]
4479         set linkid [string range $text $s $e]
4480         incr e
4481         $ctext tag delete link$linknum
4482         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4483         setlink $linkid link$linknum
4484         incr linknum
4485     }
4486 }
4487
4488 proc setlink {id lk} {
4489     global curview commitrow ctext pendinglinks commitinterest
4490
4491     if {[info exists commitrow($curview,$id)]} {
4492         $ctext tag conf $lk -foreground blue -underline 1
4493         $ctext tag bind $lk <1> [list selectline $commitrow($curview,$id) 1]
4494         $ctext tag bind $lk <Enter> {linkcursor %W 1}
4495         $ctext tag bind $lk <Leave> {linkcursor %W -1}
4496     } else {
4497         lappend pendinglinks($id) $lk
4498         lappend commitinterest($id) {makelink %I}
4499     }
4500 }
4501
4502 proc makelink {id} {
4503     global pendinglinks
4504
4505     if {![info exists pendinglinks($id)]} return
4506     foreach lk $pendinglinks($id) {
4507         setlink $id $lk
4508     }
4509     unset pendinglinks($id)
4510 }
4511
4512 proc linkcursor {w inc} {
4513     global linkentercount curtextcursor
4514
4515     if {[incr linkentercount $inc] > 0} {
4516         $w configure -cursor hand2
4517     } else {
4518         $w configure -cursor $curtextcursor
4519         if {$linkentercount < 0} {
4520             set linkentercount 0
4521         }
4522     }
4523 }
4524
4525 proc viewnextline {dir} {
4526     global canv linespc
4527
4528     $canv delete hover
4529     set ymax [lindex [$canv cget -scrollregion] 3]
4530     set wnow [$canv yview]
4531     set wtop [expr {[lindex $wnow 0] * $ymax}]
4532     set newtop [expr {$wtop + $dir * $linespc}]
4533     if {$newtop < 0} {
4534         set newtop 0
4535     } elseif {$newtop > $ymax} {
4536         set newtop $ymax
4537     }
4538     allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4539 }
4540
4541 # add a list of tag or branch names at position pos
4542 # returns the number of names inserted
4543 proc appendrefs {pos ids var} {
4544     global ctext commitrow linknum curview $var maxrefs
4545
4546     if {[catch {$ctext index $pos}]} {
4547         return 0
4548     }
4549     $ctext conf -state normal
4550     $ctext delete $pos "$pos lineend"
4551     set tags {}
4552     foreach id $ids {
4553         foreach tag [set $var\($id\)] {
4554             lappend tags [list $tag $id]
4555         }
4556     }
4557     if {[llength $tags] > $maxrefs} {
4558         $ctext insert $pos "many ([llength $tags])"
4559     } else {
4560         set tags [lsort -index 0 -decreasing $tags]
4561         set sep {}
4562         foreach ti $tags {
4563             set id [lindex $ti 1]
4564             set lk link$linknum
4565             incr linknum
4566             $ctext tag delete $lk
4567             $ctext insert $pos $sep
4568             $ctext insert $pos [lindex $ti 0] $lk
4569             setlink $id $lk
4570             set sep ", "
4571         }
4572     }
4573     $ctext conf -state disabled
4574     return [llength $tags]
4575 }
4576
4577 # called when we have finished computing the nearby tags
4578 proc dispneartags {delay} {
4579     global selectedline currentid showneartags tagphase
4580
4581     if {![info exists selectedline] || !$showneartags} return
4582     after cancel dispnexttag
4583     if {$delay} {
4584         after 200 dispnexttag
4585         set tagphase -1
4586     } else {
4587         after idle dispnexttag
4588         set tagphase 0
4589     }
4590 }
4591
4592 proc dispnexttag {} {
4593     global selectedline currentid showneartags tagphase ctext
4594
4595     if {![info exists selectedline] || !$showneartags} return
4596     switch -- $tagphase {
4597         0 {
4598             set dtags [desctags $currentid]
4599             if {$dtags ne {}} {
4600                 appendrefs precedes $dtags idtags
4601             }
4602         }
4603         1 {
4604             set atags [anctags $currentid]
4605             if {$atags ne {}} {
4606                 appendrefs follows $atags idtags
4607             }
4608         }
4609         2 {
4610             set dheads [descheads $currentid]
4611             if {$dheads ne {}} {
4612                 if {[appendrefs branch $dheads idheads] > 1
4613                     && [$ctext get "branch -3c"] eq "h"} {
4614                     # turn "Branch" into "Branches"
4615                     $ctext conf -state normal
4616                     $ctext insert "branch -2c" "es"
4617                     $ctext conf -state disabled
4618                 }
4619             }
4620         }
4621     }
4622     if {[incr tagphase] <= 2} {
4623         after idle dispnexttag
4624     }
4625 }
4626
4627 proc make_secsel {l} {
4628     global linehtag linentag linedtag canv canv2 canv3
4629
4630     if {![info exists linehtag($l)]} return
4631     $canv delete secsel
4632     set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4633                -tags secsel -fill [$canv cget -selectbackground]]
4634     $canv lower $t
4635     $canv2 delete secsel
4636     set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4637                -tags secsel -fill [$canv2 cget -selectbackground]]
4638     $canv2 lower $t
4639     $canv3 delete secsel
4640     set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4641                -tags secsel -fill [$canv3 cget -selectbackground]]
4642     $canv3 lower $t
4643 }
4644
4645 proc selectline {l isnew} {
4646     global canv ctext commitinfo selectedline
4647     global displayorder
4648     global canvy0 linespc parentlist children curview
4649     global currentid sha1entry
4650     global commentend idtags linknum
4651     global mergemax numcommits pending_select
4652     global cmitmode showneartags allcommits
4653
4654     catch {unset pending_select}
4655     $canv delete hover
4656     normalline
4657     unsel_reflist
4658     stopfinding
4659     if {$l < 0 || $l >= $numcommits} return
4660     set y [expr {$canvy0 + $l * $linespc}]
4661     set ymax [lindex [$canv cget -scrollregion] 3]
4662     set ytop [expr {$y - $linespc - 1}]
4663     set ybot [expr {$y + $linespc + 1}]
4664     set wnow [$canv yview]
4665     set wtop [expr {[lindex $wnow 0] * $ymax}]
4666     set wbot [expr {[lindex $wnow 1] * $ymax}]
4667     set wh [expr {$wbot - $wtop}]
4668     set newtop $wtop
4669     if {$ytop < $wtop} {
4670         if {$ybot < $wtop} {
4671             set newtop [expr {$y - $wh / 2.0}]
4672         } else {
4673             set newtop $ytop
4674             if {$newtop > $wtop - $linespc} {
4675                 set newtop [expr {$wtop - $linespc}]
4676             }
4677         }
4678     } elseif {$ybot > $wbot} {
4679         if {$ytop > $wbot} {
4680             set newtop [expr {$y - $wh / 2.0}]
4681         } else {
4682             set newtop [expr {$ybot - $wh}]
4683             if {$newtop < $wtop + $linespc} {
4684                 set newtop [expr {$wtop + $linespc}]
4685             }
4686         }
4687     }
4688     if {$newtop != $wtop} {
4689         if {$newtop < 0} {
4690             set newtop 0
4691         }
4692         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4693         drawvisible
4694     }
4695
4696     make_secsel $l
4697
4698     if {$isnew} {
4699         addtohistory [list selectline $l 0]
4700     }
4701
4702     set selectedline $l
4703
4704     set id [lindex $displayorder $l]
4705     set currentid $id
4706     $sha1entry delete 0 end
4707     $sha1entry insert 0 $id
4708     $sha1entry selection from 0
4709     $sha1entry selection to end
4710     rhighlight_sel $id
4711
4712     $ctext conf -state normal
4713     clear_ctext
4714     set linknum 0
4715     set info $commitinfo($id)
4716     set date [formatdate [lindex $info 2]]
4717     $ctext insert end "[mc "Author"]: [lindex $info 1]  $date\n"
4718     set date [formatdate [lindex $info 4]]
4719     $ctext insert end "[mc "Committer"]: [lindex $info 3]  $date\n"
4720     if {[info exists idtags($id)]} {
4721         $ctext insert end [mc "Tags:"]
4722         foreach tag $idtags($id) {
4723             $ctext insert end " $tag"
4724         }
4725         $ctext insert end "\n"
4726     }
4727
4728     set headers {}
4729     set olds [lindex $parentlist $l]
4730     if {[llength $olds] > 1} {
4731         set np 0
4732         foreach p $olds {
4733             if {$np >= $mergemax} {
4734                 set tag mmax
4735             } else {
4736                 set tag m$np
4737             }
4738             $ctext insert end "[mc "Parent"]: " $tag
4739             appendwithlinks [commit_descriptor $p] {}
4740             incr np
4741         }
4742     } else {
4743         foreach p $olds {
4744             append headers "[mc "Parent"]: [commit_descriptor $p]"
4745         }
4746     }
4747
4748     foreach c $children($curview,$id) {
4749         append headers "[mc "Child"]:  [commit_descriptor $c]"
4750     }
4751
4752     # make anything that looks like a SHA1 ID be a clickable link
4753     appendwithlinks $headers {}
4754     if {$showneartags} {
4755         if {![info exists allcommits]} {
4756             getallcommits
4757         }
4758         $ctext insert end "[mc "Branch"]: "
4759         $ctext mark set branch "end -1c"
4760         $ctext mark gravity branch left
4761         $ctext insert end "\n[mc "Follows"]: "
4762         $ctext mark set follows "end -1c"
4763         $ctext mark gravity follows left
4764         $ctext insert end "\n[mc "Precedes"]: "
4765         $ctext mark set precedes "end -1c"
4766         $ctext mark gravity precedes left
4767         $ctext insert end "\n"
4768         dispneartags 1
4769     }
4770     $ctext insert end "\n"
4771     set comment [lindex $info 5]
4772     if {[string first "\r" $comment] >= 0} {
4773         set comment [string map {"\r" "\n    "} $comment]
4774     }
4775     appendwithlinks $comment {comment}
4776
4777     $ctext tag remove found 1.0 end
4778     $ctext conf -state disabled
4779     set commentend [$ctext index "end - 1c"]
4780
4781     init_flist [mc "Comments"]
4782     if {$cmitmode eq "tree"} {
4783         gettree $id
4784     } elseif {[llength $olds] <= 1} {
4785         startdiff $id
4786     } else {
4787         mergediff $id $l
4788     }
4789 }
4790
4791 proc selfirstline {} {
4792     unmarkmatches
4793     selectline 0 1
4794 }
4795
4796 proc sellastline {} {
4797     global numcommits
4798     unmarkmatches
4799     set l [expr {$numcommits - 1}]
4800     selectline $l 1
4801 }
4802
4803 proc selnextline {dir} {
4804     global selectedline
4805     focus .
4806     if {![info exists selectedline]} return
4807     set l [expr {$selectedline + $dir}]
4808     unmarkmatches
4809     selectline $l 1
4810 }
4811
4812 proc selnextpage {dir} {
4813     global canv linespc selectedline numcommits
4814
4815     set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4816     if {$lpp < 1} {
4817         set lpp 1
4818     }
4819     allcanvs yview scroll [expr {$dir * $lpp}] units
4820     drawvisible
4821     if {![info exists selectedline]} return
4822     set l [expr {$selectedline + $dir * $lpp}]
4823     if {$l < 0} {
4824         set l 0
4825     } elseif {$l >= $numcommits} {
4826         set l [expr $numcommits - 1]
4827     }
4828     unmarkmatches
4829     selectline $l 1
4830 }
4831
4832 proc unselectline {} {
4833     global selectedline currentid
4834
4835     catch {unset selectedline}
4836     catch {unset currentid}
4837     allcanvs delete secsel
4838     rhighlight_none
4839 }
4840
4841 proc reselectline {} {
4842     global selectedline
4843
4844     if {[info exists selectedline]} {
4845         selectline $selectedline 0
4846     }
4847 }
4848
4849 proc addtohistory {cmd} {
4850     global history historyindex curview
4851
4852     set elt [list $curview $cmd]
4853     if {$historyindex > 0
4854         && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4855         return
4856     }
4857
4858     if {$historyindex < [llength $history]} {
4859         set history [lreplace $history $historyindex end $elt]
4860     } else {
4861         lappend history $elt
4862     }
4863     incr historyindex
4864     if {$historyindex > 1} {
4865         .tf.bar.leftbut conf -state normal
4866     } else {
4867         .tf.bar.leftbut conf -state disabled
4868     }
4869     .tf.bar.rightbut conf -state disabled
4870 }
4871
4872 proc godo {elt} {
4873     global curview
4874
4875     set view [lindex $elt 0]
4876     set cmd [lindex $elt 1]
4877     if {$curview != $view} {
4878         showview $view
4879     }
4880     eval $cmd
4881 }
4882
4883 proc goback {} {
4884     global history historyindex
4885     focus .
4886
4887     if {$historyindex > 1} {
4888         incr historyindex -1
4889         godo [lindex $history [expr {$historyindex - 1}]]
4890         .tf.bar.rightbut conf -state normal
4891     }
4892     if {$historyindex <= 1} {
4893         .tf.bar.leftbut conf -state disabled
4894     }
4895 }
4896
4897 proc goforw {} {
4898     global history historyindex
4899     focus .
4900
4901     if {$historyindex < [llength $history]} {
4902         set cmd [lindex $history $historyindex]
4903         incr historyindex
4904         godo $cmd
4905         .tf.bar.leftbut conf -state normal
4906     }
4907     if {$historyindex >= [llength $history]} {
4908         .tf.bar.rightbut conf -state disabled
4909     }
4910 }
4911
4912 proc gettree {id} {
4913     global treefilelist treeidlist diffids diffmergeid treepending
4914     global nullid nullid2
4915
4916     set diffids $id
4917     catch {unset diffmergeid}
4918     if {![info exists treefilelist($id)]} {
4919         if {![info exists treepending]} {
4920             if {$id eq $nullid} {
4921                 set cmd [list | git ls-files]
4922             } elseif {$id eq $nullid2} {
4923                 set cmd [list | git ls-files --stage -t]
4924             } else {
4925                 set cmd [list | git ls-tree -r $id]
4926             }
4927             if {[catch {set gtf [open $cmd r]}]} {
4928                 return
4929             }
4930             set treepending $id
4931             set treefilelist($id) {}
4932             set treeidlist($id) {}
4933             fconfigure $gtf -blocking 0
4934             filerun $gtf [list gettreeline $gtf $id]
4935         }
4936     } else {
4937         setfilelist $id
4938     }
4939 }
4940
4941 proc gettreeline {gtf id} {
4942     global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
4943
4944     set nl 0
4945     while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4946         if {$diffids eq $nullid} {
4947             set fname $line
4948         } else {
4949             if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
4950             set i [string first "\t" $line]
4951             if {$i < 0} continue
4952             set sha1 [lindex $line 2]
4953             set fname [string range $line [expr {$i+1}] end]
4954             if {[string index $fname 0] eq "\""} {
4955                 set fname [lindex $fname 0]
4956             }
4957             lappend treeidlist($id) $sha1
4958         }
4959         lappend treefilelist($id) $fname
4960     }
4961     if {![eof $gtf]} {
4962         return [expr {$nl >= 1000? 2: 1}]
4963     }
4964     close $gtf
4965     unset treepending
4966     if {$cmitmode ne "tree"} {
4967         if {![info exists diffmergeid]} {
4968             gettreediffs $diffids
4969         }
4970     } elseif {$id ne $diffids} {
4971         gettree $diffids
4972     } else {
4973         setfilelist $id
4974     }
4975     return 0
4976 }
4977
4978 proc showfile {f} {
4979     global treefilelist treeidlist diffids nullid nullid2
4980     global ctext commentend
4981
4982     set i [lsearch -exact $treefilelist($diffids) $f]
4983     if {$i < 0} {
4984         puts "oops, $f not in list for id $diffids"
4985         return
4986     }
4987     if {$diffids eq $nullid} {
4988         if {[catch {set bf [open $f r]} err]} {
4989             puts "oops, can't read $f: $err"
4990             return
4991         }
4992     } else {
4993         set blob [lindex $treeidlist($diffids) $i]
4994         if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4995             puts "oops, error reading blob $blob: $err"
4996             return
4997         }
4998     }
4999     fconfigure $bf -blocking 0
5000     filerun $bf [list getblobline $bf $diffids]
5001     $ctext config -state normal
5002     clear_ctext $commentend
5003     $ctext insert end "\n"
5004     $ctext insert end "$f\n" filesep
5005     $ctext config -state disabled
5006     $ctext yview $commentend
5007     settabs 0
5008 }
5009
5010 proc getblobline {bf id} {
5011     global diffids cmitmode ctext
5012
5013     if {$id ne $diffids || $cmitmode ne "tree"} {
5014         catch {close $bf}
5015         return 0
5016     }
5017     $ctext config -state normal
5018     set nl 0
5019     while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
5020         $ctext insert end "$line\n"
5021     }
5022     if {[eof $bf]} {
5023         # delete last newline
5024         $ctext delete "end - 2c" "end - 1c"
5025         close $bf
5026         return 0
5027     }
5028     $ctext config -state disabled
5029     return [expr {$nl >= 1000? 2: 1}]
5030 }
5031
5032 proc mergediff {id l} {
5033     global diffmergeid mdifffd
5034     global diffids
5035     global parentlist
5036     global limitdiffs viewfiles curview
5037
5038     set diffmergeid $id
5039     set diffids $id
5040     # this doesn't seem to actually affect anything...
5041     set cmd [concat | git diff-tree --no-commit-id --cc $id]
5042     if {$limitdiffs && $viewfiles($curview) ne {}} {
5043         set cmd [concat $cmd -- $viewfiles($curview)]
5044     }
5045     if {[catch {set mdf [open $cmd r]} err]} {
5046         error_popup "[mc "Error getting merge diffs:"] $err"
5047         return
5048     }
5049     fconfigure $mdf -blocking 0
5050     set mdifffd($id) $mdf
5051     set np [llength [lindex $parentlist $l]]
5052     settabs $np
5053     filerun $mdf [list getmergediffline $mdf $id $np]
5054 }
5055
5056 proc getmergediffline {mdf id np} {
5057     global diffmergeid ctext cflist mergemax
5058     global difffilestart mdifffd
5059
5060     $ctext conf -state normal
5061     set nr 0
5062     while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
5063         if {![info exists diffmergeid] || $id != $diffmergeid
5064             || $mdf != $mdifffd($id)} {
5065             close $mdf
5066             return 0
5067         }
5068         if {[regexp {^diff --cc (.*)} $line match fname]} {
5069             # start of a new file
5070             $ctext insert end "\n"
5071             set here [$ctext index "end - 1c"]
5072             lappend difffilestart $here
5073             add_flist [list $fname]
5074             set l [expr {(78 - [string length $fname]) / 2}]
5075             set pad [string range "----------------------------------------" 1 $l]
5076             $ctext insert end "$pad $fname $pad\n" filesep
5077         } elseif {[regexp {^@@} $line]} {
5078             $ctext insert end "$line\n" hunksep
5079         } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
5080             # do nothing
5081         } else {
5082             # parse the prefix - one ' ', '-' or '+' for each parent
5083             set spaces {}
5084             set minuses {}
5085             set pluses {}
5086             set isbad 0
5087             for {set j 0} {$j < $np} {incr j} {
5088                 set c [string range $line $j $j]
5089                 if {$c == " "} {
5090                     lappend spaces $j
5091                 } elseif {$c == "-"} {
5092                     lappend minuses $j
5093                 } elseif {$c == "+"} {
5094                     lappend pluses $j
5095                 } else {
5096                     set isbad 1
5097                     break
5098                 }
5099             }
5100             set tags {}
5101             set num {}
5102             if {!$isbad && $minuses ne {} && $pluses eq {}} {
5103                 # line doesn't appear in result, parents in $minuses have the line
5104                 set num [lindex $minuses 0]
5105             } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
5106                 # line appears in result, parents in $pluses don't have the line
5107                 lappend tags mresult
5108                 set num [lindex $spaces 0]
5109             }
5110             if {$num ne {}} {
5111                 if {$num >= $mergemax} {
5112                     set num "max"
5113                 }
5114                 lappend tags m$num
5115             }
5116             $ctext insert end "$line\n" $tags
5117         }
5118     }
5119     $ctext conf -state disabled
5120     if {[eof $mdf]} {
5121         close $mdf
5122         return 0
5123     }
5124     return [expr {$nr >= 1000? 2: 1}]
5125 }
5126
5127 proc startdiff {ids} {
5128     global treediffs diffids treepending diffmergeid nullid nullid2
5129
5130     settabs 1
5131     set diffids $ids
5132     catch {unset diffmergeid}
5133     if {![info exists treediffs($ids)] ||
5134         [lsearch -exact $ids $nullid] >= 0 ||
5135         [lsearch -exact $ids $nullid2] >= 0} {
5136         if {![info exists treepending]} {
5137             gettreediffs $ids
5138         }
5139     } else {
5140         addtocflist $ids
5141     }
5142 }
5143
5144 proc path_filter {filter name} {
5145     foreach p $filter {
5146         set l [string length $p]
5147         if {[string index $p end] eq "/"} {
5148             if {[string compare -length $l $p $name] == 0} {
5149                 return 1
5150             }
5151         } else {
5152             if {[string compare -length $l $p $name] == 0 &&
5153                 ([string length $name] == $l ||
5154                  [string index $name $l] eq "/")} {
5155                 return 1
5156             }
5157         }
5158     }
5159     return 0
5160 }
5161
5162 proc addtocflist {ids} {
5163     global treediffs
5164
5165     add_flist $treediffs($ids)
5166     getblobdiffs $ids
5167 }
5168
5169 proc diffcmd {ids flags} {
5170     global nullid nullid2
5171
5172     set i [lsearch -exact $ids $nullid]
5173     set j [lsearch -exact $ids $nullid2]
5174     if {$i >= 0} {
5175         if {[llength $ids] > 1 && $j < 0} {
5176             # comparing working directory with some specific revision
5177             set cmd [concat | git diff-index $flags]
5178             if {$i == 0} {
5179                 lappend cmd -R [lindex $ids 1]
5180             } else {
5181                 lappend cmd [lindex $ids 0]
5182             }
5183         } else {
5184             # comparing working directory with index
5185             set cmd [concat | git diff-files $flags]
5186             if {$j == 1} {
5187                 lappend cmd -R
5188             }
5189         }
5190     } elseif {$j >= 0} {
5191         set cmd [concat | git diff-index --cached $flags]
5192         if {[llength $ids] > 1} {
5193             # comparing index with specific revision
5194             if {$i == 0} {
5195                 lappend cmd -R [lindex $ids 1]
5196             } else {
5197                 lappend cmd [lindex $ids 0]
5198             }
5199         } else {
5200             # comparing index with HEAD
5201             lappend cmd HEAD
5202         }
5203     } else {
5204         set cmd [concat | git diff-tree -r $flags $ids]
5205     }
5206     return $cmd
5207 }
5208
5209 proc gettreediffs {ids} {
5210     global treediff treepending
5211
5212     set treepending $ids
5213     set treediff {}
5214     if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5215     fconfigure $gdtf -blocking 0
5216     filerun $gdtf [list gettreediffline $gdtf $ids]
5217 }
5218
5219 proc gettreediffline {gdtf ids} {
5220     global treediff treediffs treepending diffids diffmergeid
5221     global cmitmode viewfiles curview limitdiffs
5222
5223     set nr 0
5224     while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
5225         set i [string first "\t" $line]
5226         if {$i >= 0} {
5227             set file [string range $line [expr {$i+1}] end]
5228             if {[string index $file 0] eq "\""} {
5229                 set file [lindex $file 0]
5230             }
5231             lappend treediff $file
5232         }
5233     }
5234     if {![eof $gdtf]} {
5235         return [expr {$nr >= 1000? 2: 1}]
5236     }
5237     close $gdtf
5238     if {$limitdiffs && $viewfiles($curview) ne {}} {
5239         set flist {}
5240         foreach f $treediff {
5241             if {[path_filter $viewfiles($curview) $f]} {
5242                 lappend flist $f
5243             }
5244         }
5245         set treediffs($ids) $flist
5246     } else {
5247         set treediffs($ids) $treediff
5248     }
5249     unset treepending
5250     if {$cmitmode eq "tree"} {
5251         gettree $diffids
5252     } elseif {$ids != $diffids} {
5253         if {![info exists diffmergeid]} {
5254             gettreediffs $diffids
5255         }
5256     } else {
5257         addtocflist $ids
5258     }
5259     return 0
5260 }
5261
5262 # empty string or positive integer
5263 proc diffcontextvalidate {v} {
5264     return [regexp {^(|[1-9][0-9]*)$} $v]
5265 }
5266
5267 proc diffcontextchange {n1 n2 op} {
5268     global diffcontextstring diffcontext
5269
5270     if {[string is integer -strict $diffcontextstring]} {
5271         if {$diffcontextstring > 0} {
5272             set diffcontext $diffcontextstring
5273             reselectline
5274         }
5275     }
5276 }
5277
5278 proc changeignorespace {} {
5279     reselectline
5280 }
5281
5282 proc getblobdiffs {ids} {
5283     global blobdifffd diffids env
5284     global diffinhdr treediffs
5285     global diffcontext
5286     global ignorespace
5287     global limitdiffs viewfiles curview
5288
5289     set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
5290     if {$ignorespace} {
5291         append cmd " -w"
5292     }
5293     if {$limitdiffs && $viewfiles($curview) ne {}} {
5294         set cmd [concat $cmd -- $viewfiles($curview)]
5295     }
5296     if {[catch {set bdf [open $cmd r]} err]} {
5297         puts "error getting diffs: $err"
5298         return
5299     }
5300     set diffinhdr 0
5301     fconfigure $bdf -blocking 0
5302     set blobdifffd($ids) $bdf
5303     filerun $bdf [list getblobdiffline $bdf $diffids]
5304 }
5305
5306 proc setinlist {var i val} {
5307     global $var
5308
5309     while {[llength [set $var]] < $i} {
5310         lappend $var {}
5311     }
5312     if {[llength [set $var]] == $i} {
5313         lappend $var $val
5314     } else {
5315         lset $var $i $val
5316     }
5317 }
5318
5319 proc makediffhdr {fname ids} {
5320     global ctext curdiffstart treediffs
5321
5322     set i [lsearch -exact $treediffs($ids) $fname]
5323     if {$i >= 0} {
5324         setinlist difffilestart $i $curdiffstart
5325     }
5326     set l [expr {(78 - [string length $fname]) / 2}]
5327     set pad [string range "----------------------------------------" 1 $l]
5328     $ctext insert $curdiffstart "$pad $fname $pad" filesep
5329 }
5330
5331 proc getblobdiffline {bdf ids} {
5332     global diffids blobdifffd ctext curdiffstart
5333     global diffnexthead diffnextnote difffilestart
5334     global diffinhdr treediffs
5335
5336     set nr 0
5337     $ctext conf -state normal
5338     while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
5339         if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
5340             close $bdf
5341             return 0
5342         }
5343         if {![string compare -length 11 "diff --git " $line]} {
5344             # trim off "diff --git "
5345             set line [string range $line 11 end]
5346             set diffinhdr 1
5347             # start of a new file
5348             $ctext insert end "\n"
5349             set curdiffstart [$ctext index "end - 1c"]
5350             $ctext insert end "\n" filesep
5351             # If the name hasn't changed the length will be odd,
5352             # the middle char will be a space, and the two bits either
5353             # side will be a/name and b/name, or "a/name" and "b/name".
5354             # If the name has changed we'll get "rename from" and
5355             # "rename to" or "copy from" and "copy to" lines following this,
5356             # and we'll use them to get the filenames.
5357             # This complexity is necessary because spaces in the filename(s)
5358             # don't get escaped.
5359             set l [string length $line]
5360             set i [expr {$l / 2}]
5361             if {!(($l & 1) && [string index $line $i] eq " " &&
5362                   [string range $line 2 [expr {$i - 1}]] eq \
5363                       [string range $line [expr {$i + 3}] end])} {
5364                 continue
5365             }
5366             # unescape if quoted and chop off the a/ from the front
5367             if {[string index $line 0] eq "\""} {
5368                 set fname [string range [lindex $line 0] 2 end]
5369             } else {
5370                 set fname [string range $line 2 [expr {$i - 1}]]
5371             }
5372             makediffhdr $fname $ids
5373
5374         } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
5375                        $line match f1l f1c f2l f2c rest]} {
5376             $ctext insert end "$line\n" hunksep
5377             set diffinhdr 0
5378
5379         } elseif {$diffinhdr} {
5380             if {![string compare -length 12 "rename from " $line]} {
5381                 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
5382                 if {[string index $fname 0] eq "\""} {
5383                     set fname [lindex $fname 0]
5384                 }
5385                 set i [lsearch -exact $treediffs($ids) $fname]
5386                 if {$i >= 0} {
5387                     setinlist difffilestart $i $curdiffstart
5388                 }
5389             } elseif {![string compare -length 10 $line "rename to "] ||
5390                       ![string compare -length 8 $line "copy to "]} {
5391                 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
5392                 if {[string index $fname 0] eq "\""} {
5393                     set fname [lindex $fname 0]
5394                 }
5395                 makediffhdr $fname $ids
5396             } elseif {[string compare -length 3 $line "---"] == 0} {
5397                 # do nothing
5398                 continue
5399             } elseif {[string compare -length 3 $line "+++"] == 0} {
5400                 set diffinhdr 0
5401                 continue
5402             }
5403             $ctext insert end "$line\n" filesep
5404
5405         } else {
5406             set x [string range $line 0 0]
5407             if {$x == "-" || $x == "+"} {
5408                 set tag [expr {$x == "+"}]
5409                 $ctext insert end "$line\n" d$tag
5410             } elseif {$x == " "} {
5411                 $ctext insert end "$line\n"
5412             } else {
5413                 # "\ No newline at end of file",
5414                 # or something else we don't recognize
5415                 $ctext insert end "$line\n" hunksep
5416             }
5417         }
5418     }
5419     $ctext conf -state disabled
5420     if {[eof $bdf]} {
5421         close $bdf
5422         return 0
5423     }
5424     return [expr {$nr >= 1000? 2: 1}]
5425 }
5426
5427 proc changediffdisp {} {
5428     global ctext diffelide
5429
5430     $ctext tag conf d0 -elide [lindex $diffelide 0]
5431     $ctext tag conf d1 -elide [lindex $diffelide 1]
5432 }
5433
5434 proc prevfile {} {
5435     global difffilestart ctext
5436     set prev [lindex $difffilestart 0]
5437     set here [$ctext index @0,0]
5438     foreach loc $difffilestart {
5439         if {[$ctext compare $loc >= $here]} {
5440             $ctext yview $prev
5441             return
5442         }
5443         set prev $loc
5444     }
5445     $ctext yview $prev
5446 }
5447
5448 proc nextfile {} {
5449     global difffilestart ctext
5450     set here [$ctext index @0,0]
5451     foreach loc $difffilestart {
5452         if {[$ctext compare $loc > $here]} {
5453             $ctext yview $loc
5454             return
5455         }
5456     }
5457 }
5458
5459 proc clear_ctext {{first 1.0}} {
5460     global ctext smarktop smarkbot
5461     global pendinglinks
5462
5463     set l [lindex [split $first .] 0]
5464     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5465         set smarktop $l
5466     }
5467     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5468         set smarkbot $l
5469     }
5470     $ctext delete $first end
5471     if {$first eq "1.0"} {
5472         catch {unset pendinglinks}
5473     }
5474 }
5475
5476 proc settabs {{firstab {}}} {
5477     global firsttabstop tabstop ctext have_tk85
5478
5479     if {$firstab ne {} && $have_tk85} {
5480         set firsttabstop $firstab
5481     }
5482     set w [font measure textfont "0"]
5483     if {$firsttabstop != 0} {
5484         $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
5485                                [expr {($firsttabstop + 2 * $tabstop) * $w}]]
5486     } elseif {$have_tk85 || $tabstop != 8} {
5487         $ctext conf -tabs [expr {$tabstop * $w}]
5488     } else {
5489         $ctext conf -tabs {}
5490     }
5491 }
5492
5493 proc incrsearch {name ix op} {
5494     global ctext searchstring searchdirn
5495
5496     $ctext tag remove found 1.0 end
5497     if {[catch {$ctext index anchor}]} {
5498         # no anchor set, use start of selection, or of visible area
5499         set sel [$ctext tag ranges sel]
5500         if {$sel ne {}} {
5501             $ctext mark set anchor [lindex $sel 0]
5502         } elseif {$searchdirn eq "-forwards"} {
5503             $ctext mark set anchor @0,0
5504         } else {
5505             $ctext mark set anchor @0,[winfo height $ctext]
5506         }
5507     }
5508     if {$searchstring ne {}} {
5509         set here [$ctext search $searchdirn -- $searchstring anchor]
5510         if {$here ne {}} {
5511             $ctext see $here
5512         }
5513         searchmarkvisible 1
5514     }
5515 }
5516
5517 proc dosearch {} {
5518     global sstring ctext searchstring searchdirn
5519
5520     focus $sstring
5521     $sstring icursor end
5522     set searchdirn -forwards
5523     if {$searchstring ne {}} {
5524         set sel [$ctext tag ranges sel]
5525         if {$sel ne {}} {
5526             set start "[lindex $sel 0] + 1c"
5527         } elseif {[catch {set start [$ctext index anchor]}]} {
5528             set start "@0,0"
5529         }
5530         set match [$ctext search -count mlen -- $searchstring $start]
5531         $ctext tag remove sel 1.0 end
5532         if {$match eq {}} {
5533             bell
5534             return
5535         }
5536         $ctext see $match
5537         set mend "$match + $mlen c"
5538         $ctext tag add sel $match $mend
5539         $ctext mark unset anchor
5540     }
5541 }
5542
5543 proc dosearchback {} {
5544     global sstring ctext searchstring searchdirn
5545
5546     focus $sstring
5547     $sstring icursor end
5548     set searchdirn -backwards
5549     if {$searchstring ne {}} {
5550         set sel [$ctext tag ranges sel]
5551         if {$sel ne {}} {
5552             set start [lindex $sel 0]
5553         } elseif {[catch {set start [$ctext index anchor]}]} {
5554             set start @0,[winfo height $ctext]
5555         }
5556         set match [$ctext search -backwards -count ml -- $searchstring $start]
5557         $ctext tag remove sel 1.0 end
5558         if {$match eq {}} {
5559             bell
5560             return
5561         }
5562         $ctext see $match
5563         set mend "$match + $ml c"
5564         $ctext tag add sel $match $mend
5565         $ctext mark unset anchor
5566     }
5567 }
5568
5569 proc searchmark {first last} {
5570     global ctext searchstring
5571
5572     set mend $first.0
5573     while {1} {
5574         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5575         if {$match eq {}} break
5576         set mend "$match + $mlen c"
5577         $ctext tag add found $match $mend
5578     }
5579 }
5580
5581 proc searchmarkvisible {doall} {
5582     global ctext smarktop smarkbot
5583
5584     set topline [lindex [split [$ctext index @0,0] .] 0]
5585     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5586     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5587         # no overlap with previous
5588         searchmark $topline $botline
5589         set smarktop $topline
5590         set smarkbot $botline
5591     } else {
5592         if {$topline < $smarktop} {
5593             searchmark $topline [expr {$smarktop-1}]
5594             set smarktop $topline
5595         }
5596         if {$botline > $smarkbot} {
5597             searchmark [expr {$smarkbot+1}] $botline
5598             set smarkbot $botline
5599         }
5600     }
5601 }
5602
5603 proc scrolltext {f0 f1} {
5604     global searchstring
5605
5606     .bleft.sb set $f0 $f1
5607     if {$searchstring ne {}} {
5608         searchmarkvisible 0
5609     }
5610 }
5611
5612 proc setcoords {} {
5613     global linespc charspc canvx0 canvy0
5614     global xspc1 xspc2 lthickness
5615
5616     set linespc [font metrics mainfont -linespace]
5617     set charspc [font measure mainfont "m"]
5618     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5619     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5620     set lthickness [expr {int($linespc / 9) + 1}]
5621     set xspc1(0) $linespc
5622     set xspc2 $linespc
5623 }
5624
5625 proc redisplay {} {
5626     global canv
5627     global selectedline
5628
5629     set ymax [lindex [$canv cget -scrollregion] 3]
5630     if {$ymax eq {} || $ymax == 0} return
5631     set span [$canv yview]
5632     clear_display
5633     setcanvscroll
5634     allcanvs yview moveto [lindex $span 0]
5635     drawvisible
5636     if {[info exists selectedline]} {
5637         selectline $selectedline 0
5638         allcanvs yview moveto [lindex $span 0]
5639     }
5640 }
5641
5642 proc parsefont {f n} {
5643     global fontattr
5644
5645     set fontattr($f,family) [lindex $n 0]
5646     set s [lindex $n 1]
5647     if {$s eq {} || $s == 0} {
5648         set s 10
5649     } elseif {$s < 0} {
5650         set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
5651     }
5652     set fontattr($f,size) $s
5653     set fontattr($f,weight) normal
5654     set fontattr($f,slant) roman
5655     foreach style [lrange $n 2 end] {
5656         switch -- $style {
5657             "normal" -
5658             "bold"   {set fontattr($f,weight) $style}
5659             "roman" -
5660             "italic" {set fontattr($f,slant) $style}
5661         }
5662     }
5663 }
5664
5665 proc fontflags {f {isbold 0}} {
5666     global fontattr
5667
5668     return [list -family $fontattr($f,family) -size $fontattr($f,size) \
5669                 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
5670                 -slant $fontattr($f,slant)]
5671 }
5672
5673 proc fontname {f} {
5674     global fontattr
5675
5676     set n [list $fontattr($f,family) $fontattr($f,size)]
5677     if {$fontattr($f,weight) eq "bold"} {
5678         lappend n "bold"
5679     }
5680     if {$fontattr($f,slant) eq "italic"} {
5681         lappend n "italic"
5682     }
5683     return $n
5684 }
5685
5686 proc incrfont {inc} {
5687     global mainfont textfont ctext canv phase cflist showrefstop
5688     global stopped entries fontattr
5689
5690     unmarkmatches
5691     set s $fontattr(mainfont,size)
5692     incr s $inc
5693     if {$s < 1} {
5694         set s 1
5695     }
5696     set fontattr(mainfont,size) $s
5697     font config mainfont -size $s
5698     font config mainfontbold -size $s
5699     set mainfont [fontname mainfont]
5700     set s $fontattr(textfont,size)
5701     incr s $inc
5702     if {$s < 1} {
5703         set s 1
5704     }
5705     set fontattr(textfont,size) $s
5706     font config textfont -size $s
5707     font config textfontbold -size $s
5708     set textfont [fontname textfont]
5709     setcoords
5710     settabs
5711     redisplay
5712 }
5713
5714 proc clearsha1 {} {
5715     global sha1entry sha1string
5716     if {[string length $sha1string] == 40} {
5717         $sha1entry delete 0 end
5718     }
5719 }
5720
5721 proc sha1change {n1 n2 op} {
5722     global sha1string currentid sha1but
5723     if {$sha1string == {}
5724         || ([info exists currentid] && $sha1string == $currentid)} {
5725         set state disabled
5726     } else {
5727         set state normal
5728     }
5729     if {[$sha1but cget -state] == $state} return
5730     if {$state == "normal"} {
5731         $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
5732     } else {
5733         $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
5734     }
5735 }
5736
5737 proc gotocommit {} {
5738     global sha1string currentid commitrow tagids headids
5739     global displayorder numcommits curview
5740
5741     if {$sha1string == {}
5742         || ([info exists currentid] && $sha1string == $currentid)} return
5743     if {[info exists tagids($sha1string)]} {
5744         set id $tagids($sha1string)
5745     } elseif {[info exists headids($sha1string)]} {
5746         set id $headids($sha1string)
5747     } else {
5748         set id [string tolower $sha1string]
5749         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5750             set matches {}
5751             foreach i $displayorder {
5752                 if {[string match $id* $i]} {
5753                     lappend matches $i
5754                 }
5755             }
5756             if {$matches ne {}} {
5757                 if {[llength $matches] > 1} {
5758                     error_popup [mc "Short SHA1 id %s is ambiguous" $id]
5759                     return
5760                 }
5761                 set id [lindex $matches 0]
5762             }
5763         }
5764     }
5765     if {[info exists commitrow($curview,$id)]} {
5766         selectline $commitrow($curview,$id) 1
5767         return
5768     }
5769     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5770         set msg [mc "SHA1 id %s is not known" $sha1string]
5771     } else {
5772         set msg [mc "Tag/Head %s is not known" $sha1string]
5773     }
5774     error_popup $msg
5775 }
5776
5777 proc lineenter {x y id} {
5778     global hoverx hovery hoverid hovertimer
5779     global commitinfo canv
5780
5781     if {![info exists commitinfo($id)] && ![getcommit $id]} return
5782     set hoverx $x
5783     set hovery $y
5784     set hoverid $id
5785     if {[info exists hovertimer]} {
5786         after cancel $hovertimer
5787     }
5788     set hovertimer [after 500 linehover]
5789     $canv delete hover
5790 }
5791
5792 proc linemotion {x y id} {
5793     global hoverx hovery hoverid hovertimer
5794
5795     if {[info exists hoverid] && $id == $hoverid} {
5796         set hoverx $x
5797         set hovery $y
5798         if {[info exists hovertimer]} {
5799             after cancel $hovertimer
5800         }
5801         set hovertimer [after 500 linehover]
5802     }
5803 }
5804
5805 proc lineleave {id} {
5806     global hoverid hovertimer canv
5807
5808     if {[info exists hoverid] && $id == $hoverid} {
5809         $canv delete hover
5810         if {[info exists hovertimer]} {
5811             after cancel $hovertimer
5812             unset hovertimer
5813         }
5814         unset hoverid
5815     }
5816 }
5817
5818 proc linehover {} {
5819     global hoverx hovery hoverid hovertimer
5820     global canv linespc lthickness
5821     global commitinfo
5822
5823     set text [lindex $commitinfo($hoverid) 0]
5824     set ymax [lindex [$canv cget -scrollregion] 3]
5825     if {$ymax == {}} return
5826     set yfrac [lindex [$canv yview] 0]
5827     set x [expr {$hoverx + 2 * $linespc}]
5828     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5829     set x0 [expr {$x - 2 * $lthickness}]
5830     set y0 [expr {$y - 2 * $lthickness}]
5831     set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
5832     set y1 [expr {$y + $linespc + 2 * $lthickness}]
5833     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5834                -fill \#ffff80 -outline black -width 1 -tags hover]
5835     $canv raise $t
5836     set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5837                -font mainfont]
5838     $canv raise $t
5839 }
5840
5841 proc clickisonarrow {id y} {
5842     global lthickness
5843
5844     set ranges [rowranges $id]
5845     set thresh [expr {2 * $lthickness + 6}]
5846     set n [expr {[llength $ranges] - 1}]
5847     for {set i 1} {$i < $n} {incr i} {
5848         set row [lindex $ranges $i]
5849         if {abs([yc $row] - $y) < $thresh} {
5850             return $i
5851         }
5852     }
5853     return {}
5854 }
5855
5856 proc arrowjump {id n y} {
5857     global canv
5858
5859     # 1 <-> 2, 3 <-> 4, etc...
5860     set n [expr {(($n - 1) ^ 1) + 1}]
5861     set row [lindex [rowranges $id] $n]
5862     set yt [yc $row]
5863     set ymax [lindex [$canv cget -scrollregion] 3]
5864     if {$ymax eq {} || $ymax <= 0} return
5865     set view [$canv yview]
5866     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5867     set yfrac [expr {$yt / $ymax - $yspan / 2}]
5868     if {$yfrac < 0} {
5869         set yfrac 0
5870     }
5871     allcanvs yview moveto $yfrac
5872 }
5873
5874 proc lineclick {x y id isnew} {
5875     global ctext commitinfo children canv thickerline curview commitrow
5876
5877     if {![info exists commitinfo($id)] && ![getcommit $id]} return
5878     unmarkmatches
5879     unselectline
5880     normalline
5881     $canv delete hover
5882     # draw this line thicker than normal
5883     set thickerline $id
5884     drawlines $id
5885     if {$isnew} {
5886         set ymax [lindex [$canv cget -scrollregion] 3]
5887         if {$ymax eq {}} return
5888         set yfrac [lindex [$canv yview] 0]
5889         set y [expr {$y + $yfrac * $ymax}]
5890     }
5891     set dirn [clickisonarrow $id $y]
5892     if {$dirn ne {}} {
5893         arrowjump $id $dirn $y
5894         return
5895     }
5896
5897     if {$isnew} {
5898         addtohistory [list lineclick $x $y $id 0]
5899     }
5900     # fill the details pane with info about this line
5901     $ctext conf -state normal
5902     clear_ctext
5903     settabs 0
5904     $ctext insert end "[mc "Parent"]:\t"
5905     $ctext insert end $id link0
5906     setlink $id link0
5907     set info $commitinfo($id)
5908     $ctext insert end "\n\t[lindex $info 0]\n"
5909     $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
5910     set date [formatdate [lindex $info 2]]
5911     $ctext insert end "\t[mc "Date"]:\t$date\n"
5912     set kids $children($curview,$id)
5913     if {$kids ne {}} {
5914         $ctext insert end "\n[mc "Children"]:"
5915         set i 0
5916         foreach child $kids {
5917             incr i
5918             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5919             set info $commitinfo($child)
5920             $ctext insert end "\n\t"
5921             $ctext insert end $child link$i
5922             setlink $child link$i
5923             $ctext insert end "\n\t[lindex $info 0]"
5924             $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
5925             set date [formatdate [lindex $info 2]]
5926             $ctext insert end "\n\t[mc "Date"]:\t$date\n"
5927         }
5928     }
5929     $ctext conf -state disabled
5930     init_flist {}
5931 }
5932
5933 proc normalline {} {
5934     global thickerline
5935     if {[info exists thickerline]} {
5936         set id $thickerline
5937         unset thickerline
5938         drawlines $id
5939     }
5940 }
5941
5942 proc selbyid {id} {
5943     global commitrow curview
5944     if {[info exists commitrow($curview,$id)]} {
5945         selectline $commitrow($curview,$id) 1
5946     }
5947 }
5948
5949 proc mstime {} {
5950     global startmstime
5951     if {![info exists startmstime]} {
5952         set startmstime [clock clicks -milliseconds]
5953     }
5954     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5955 }
5956
5957 proc rowmenu {x y id} {
5958     global rowctxmenu commitrow selectedline rowmenuid curview
5959     global nullid nullid2 fakerowmenu mainhead
5960
5961     stopfinding
5962     set rowmenuid $id
5963     if {![info exists selectedline]
5964         || $commitrow($curview,$id) eq $selectedline} {
5965         set state disabled
5966     } else {
5967         set state normal
5968     }
5969     if {$id ne $nullid && $id ne $nullid2} {
5970         set menu $rowctxmenu
5971         $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
5972     } else {
5973         set menu $fakerowmenu
5974     }
5975     $menu entryconfigure [mc "Diff this -> selected"] -state $state
5976     $menu entryconfigure [mc "Diff selected -> this"] -state $state
5977     $menu entryconfigure [mc "Make patch"] -state $state
5978     tk_popup $menu $x $y
5979 }
5980
5981 proc diffvssel {dirn} {
5982     global rowmenuid selectedline displayorder
5983
5984     if {![info exists selectedline]} return
5985     if {$dirn} {
5986         set oldid [lindex $displayorder $selectedline]
5987         set newid $rowmenuid
5988     } else {
5989         set oldid $rowmenuid
5990         set newid [lindex $displayorder $selectedline]
5991     }
5992     addtohistory [list doseldiff $oldid $newid]
5993     doseldiff $oldid $newid
5994 }
5995
5996 proc doseldiff {oldid newid} {
5997     global ctext
5998     global commitinfo
5999
6000     $ctext conf -state normal
6001     clear_ctext
6002     init_flist [mc "Top"]
6003     $ctext insert end "[mc "From"] "
6004     $ctext insert end $oldid link0
6005     setlink $oldid link0
6006     $ctext insert end "\n     "
6007     $ctext insert end [lindex $commitinfo($oldid) 0]
6008     $ctext insert end "\n\n[mc "To"]   "
6009     $ctext insert end $newid link1
6010     setlink $newid link1
6011     $ctext insert end "\n     "
6012     $ctext insert end [lindex $commitinfo($newid) 0]
6013     $ctext insert end "\n"
6014     $ctext conf -state disabled
6015     $ctext tag remove found 1.0 end
6016     startdiff [list $oldid $newid]
6017 }
6018
6019 proc mkpatch {} {
6020     global rowmenuid currentid commitinfo patchtop patchnum
6021
6022     if {![info exists currentid]} return
6023     set oldid $currentid
6024     set oldhead [lindex $commitinfo($oldid) 0]
6025     set newid $rowmenuid
6026     set newhead [lindex $commitinfo($newid) 0]
6027     set top .patch
6028     set patchtop $top
6029     catch {destroy $top}
6030     toplevel $top
6031     label $top.title -text [mc "Generate patch"]
6032     grid $top.title - -pady 10
6033     label $top.from -text [mc "From:"]
6034     entry $top.fromsha1 -width 40 -relief flat
6035     $top.fromsha1 insert 0 $oldid
6036     $top.fromsha1 conf -state readonly
6037     grid $top.from $top.fromsha1 -sticky w
6038     entry $top.fromhead -width 60 -relief flat
6039     $top.fromhead insert 0 $oldhead
6040     $top.fromhead conf -state readonly
6041     grid x $top.fromhead -sticky w
6042     label $top.to -text [mc "To:"]
6043     entry $top.tosha1 -width 40 -relief flat
6044     $top.tosha1 insert 0 $newid
6045     $top.tosha1 conf -state readonly
6046     grid $top.to $top.tosha1 -sticky w
6047     entry $top.tohead -width 60 -relief flat
6048     $top.tohead insert 0 $newhead
6049     $top.tohead conf -state readonly
6050     grid x $top.tohead -sticky w
6051     button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
6052     grid $top.rev x -pady 10
6053     label $top.flab -text [mc "Output file:"]
6054     entry $top.fname -width 60
6055     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
6056     incr patchnum
6057     grid $top.flab $top.fname -sticky w
6058     frame $top.buts
6059     button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
6060     button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
6061     grid $top.buts.gen $top.buts.can
6062     grid columnconfigure $top.buts 0 -weight 1 -uniform a
6063     grid columnconfigure $top.buts 1 -weight 1 -uniform a
6064     grid $top.buts - -pady 10 -sticky ew
6065     focus $top.fname
6066 }
6067
6068 proc mkpatchrev {} {
6069     global patchtop
6070
6071     set oldid [$patchtop.fromsha1 get]
6072     set oldhead [$patchtop.fromhead get]
6073     set newid [$patchtop.tosha1 get]
6074     set newhead [$patchtop.tohead get]
6075     foreach e [list fromsha1 fromhead tosha1 tohead] \
6076             v [list $newid $newhead $oldid $oldhead] {
6077         $patchtop.$e conf -state normal
6078         $patchtop.$e delete 0 end
6079         $patchtop.$e insert 0 $v
6080         $patchtop.$e conf -state readonly
6081     }
6082 }
6083
6084 proc mkpatchgo {} {
6085     global patchtop nullid nullid2
6086
6087     set oldid [$patchtop.fromsha1 get]
6088     set newid [$patchtop.tosha1 get]
6089     set fname [$patchtop.fname get]
6090     set cmd [diffcmd [list $oldid $newid] -p]
6091     # trim off the initial "|"
6092     set cmd [lrange $cmd 1 end]
6093     lappend cmd >$fname &
6094     if {[catch {eval exec $cmd} err]} {
6095         error_popup "[mc "Error creating patch:"] $err"
6096     }
6097     catch {destroy $patchtop}
6098     unset patchtop
6099 }
6100
6101 proc mkpatchcan {} {
6102     global patchtop
6103
6104     catch {destroy $patchtop}
6105     unset patchtop
6106 }
6107
6108 proc mktag {} {
6109     global rowmenuid mktagtop commitinfo
6110
6111     set top .maketag
6112     set mktagtop $top
6113     catch {destroy $top}
6114     toplevel $top
6115     label $top.title -text [mc "Create tag"]
6116     grid $top.title - -pady 10
6117     label $top.id -text [mc "ID:"]
6118     entry $top.sha1 -width 40 -relief flat
6119     $top.sha1 insert 0 $rowmenuid
6120     $top.sha1 conf -state readonly
6121     grid $top.id $top.sha1 -sticky w
6122     entry $top.head -width 60 -relief flat
6123     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6124     $top.head conf -state readonly
6125     grid x $top.head -sticky w
6126     label $top.tlab -text [mc "Tag name:"]
6127     entry $top.tag -width 60
6128     grid $top.tlab $top.tag -sticky w
6129     frame $top.buts
6130     button $top.buts.gen -text [mc "Create"] -command mktaggo
6131     button $top.buts.can -text [mc "Cancel"] -command mktagcan
6132     grid $top.buts.gen $top.buts.can
6133     grid columnconfigure $top.buts 0 -weight 1 -uniform a
6134     grid columnconfigure $top.buts 1 -weight 1 -uniform a
6135     grid $top.buts - -pady 10 -sticky ew
6136     focus $top.tag
6137 }
6138
6139 proc domktag {} {
6140     global mktagtop env tagids idtags
6141
6142     set id [$mktagtop.sha1 get]
6143     set tag [$mktagtop.tag get]
6144     if {$tag == {}} {
6145         error_popup [mc "No tag name specified"]
6146         return
6147     }
6148     if {[info exists tagids($tag)]} {
6149         error_popup [mc "Tag \"%s\" already exists" $tag]
6150         return
6151     }
6152     if {[catch {
6153         exec git tag $tag $id
6154     } err]} {
6155         error_popup "[mc "Error creating tag:"] $err"
6156         return
6157     }
6158
6159     set tagids($tag) $id
6160     lappend idtags($id) $tag
6161     redrawtags $id
6162     addedtag $id
6163     dispneartags 0
6164     run refill_reflist
6165 }
6166
6167 proc redrawtags {id} {
6168     global canv linehtag commitrow idpos selectedline curview
6169     global canvxmax iddrawn
6170
6171     if {![info exists commitrow($curview,$id)]} return
6172     if {![info exists iddrawn($id)]} return
6173     drawcommits $commitrow($curview,$id)
6174     $canv delete tag.$id
6175     set xt [eval drawtags $id $idpos($id)]
6176     $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
6177     set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
6178     set xr [expr {$xt + [font measure mainfont $text]}]
6179     if {$xr > $canvxmax} {
6180         set canvxmax $xr
6181         setcanvscroll
6182     }
6183     if {[info exists selectedline]
6184         && $selectedline == $commitrow($curview,$id)} {
6185         selectline $selectedline 0
6186     }
6187 }
6188
6189 proc mktagcan {} {
6190     global mktagtop
6191
6192     catch {destroy $mktagtop}
6193     unset mktagtop
6194 }
6195
6196 proc mktaggo {} {
6197     domktag
6198     mktagcan
6199 }
6200
6201 proc writecommit {} {
6202     global rowmenuid wrcomtop commitinfo wrcomcmd
6203
6204     set top .writecommit
6205     set wrcomtop $top
6206     catch {destroy $top}
6207     toplevel $top
6208     label $top.title -text [mc "Write commit to file"]
6209     grid $top.title - -pady 10
6210     label $top.id -text [mc "ID:"]
6211     entry $top.sha1 -width 40 -relief flat
6212     $top.sha1 insert 0 $rowmenuid
6213     $top.sha1 conf -state readonly
6214     grid $top.id $top.sha1 -sticky w
6215     entry $top.head -width 60 -relief flat
6216     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6217     $top.head conf -state readonly
6218     grid x $top.head -sticky w
6219     label $top.clab -text [mc "Command:"]
6220     entry $top.cmd -width 60 -textvariable wrcomcmd
6221     grid $top.clab $top.cmd -sticky w -pady 10
6222     label $top.flab -text [mc "Output file:"]
6223     entry $top.fname -width 60
6224     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
6225     grid $top.flab $top.fname -sticky w
6226     frame $top.buts
6227     button $top.buts.gen -text [mc "Write"] -command wrcomgo
6228     button $top.buts.can -text [mc "Cancel"] -command wrcomcan
6229     grid $top.buts.gen $top.buts.can
6230     grid columnconfigure $top.buts 0 -weight 1 -uniform a
6231     grid columnconfigure $top.buts 1 -weight 1 -uniform a
6232     grid $top.buts - -pady 10 -sticky ew
6233     focus $top.fname
6234 }
6235
6236 proc wrcomgo {} {
6237     global wrcomtop
6238
6239     set id [$wrcomtop.sha1 get]
6240     set cmd "echo $id | [$wrcomtop.cmd get]"
6241     set fname [$wrcomtop.fname get]
6242     if {[catch {exec sh -c $cmd >$fname &} err]} {
6243         error_popup "[mc "Error writing commit:"] $err"
6244     }
6245     catch {destroy $wrcomtop}
6246     unset wrcomtop
6247 }
6248
6249 proc wrcomcan {} {
6250     global wrcomtop
6251
6252     catch {destroy $wrcomtop}
6253     unset wrcomtop
6254 }
6255
6256 proc mkbranch {} {
6257     global rowmenuid mkbrtop
6258
6259     set top .makebranch
6260     catch {destroy $top}
6261     toplevel $top
6262     label $top.title -text [mc "Create new branch"]
6263     grid $top.title - -pady 10
6264     label $top.id -text [mc "ID:"]
6265     entry $top.sha1 -width 40 -relief flat
6266     $top.sha1 insert 0 $rowmenuid
6267     $top.sha1 conf -state readonly
6268     grid $top.id $top.sha1 -sticky w
6269     label $top.nlab -text [mc "Name:"]
6270     entry $top.name -width 40
6271     grid $top.nlab $top.name -sticky w
6272     frame $top.buts
6273     button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
6274     button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
6275     grid $top.buts.go $top.buts.can
6276     grid columnconfigure $top.buts 0 -weight 1 -uniform a
6277     grid columnconfigure $top.buts 1 -weight 1 -uniform a
6278     grid $top.buts - -pady 10 -sticky ew
6279     focus $top.name
6280 }
6281
6282 proc mkbrgo {top} {
6283     global headids idheads
6284
6285     set name [$top.name get]
6286     set id [$top.sha1 get]
6287     if {$name eq {}} {
6288         error_popup [mc "Please specify a name for the new branch"]
6289         return
6290     }
6291     catch {destroy $top}
6292     nowbusy newbranch
6293     update
6294     if {[catch {
6295         exec git branch $name $id
6296     } err]} {
6297         notbusy newbranch
6298         error_popup $err
6299     } else {
6300         set headids($name) $id
6301         lappend idheads($id) $name
6302         addedhead $id $name
6303         notbusy newbranch
6304         redrawtags $id
6305         dispneartags 0
6306         run refill_reflist
6307     }
6308 }
6309
6310 proc cherrypick {} {
6311     global rowmenuid curview commitrow
6312     global mainhead
6313
6314     set oldhead [exec git rev-parse HEAD]
6315     set dheads [descheads $rowmenuid]
6316     if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
6317         set ok [confirm_popup [mc "Commit %s is already\
6318                 included in branch %s -- really re-apply it?" \
6319                                    [string range $rowmenuid 0 7] $mainhead]]
6320         if {!$ok} return
6321     }
6322     nowbusy cherrypick [mc "Cherry-picking"]
6323     update
6324     # Unfortunately git-cherry-pick writes stuff to stderr even when
6325     # no error occurs, and exec takes that as an indication of error...
6326     if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
6327         notbusy cherrypick
6328         error_popup $err
6329         return
6330     }
6331     set newhead [exec git rev-parse HEAD]
6332     if {$newhead eq $oldhead} {
6333         notbusy cherrypick
6334         error_popup [mc "No changes committed"]
6335         return
6336     }
6337     addnewchild $newhead $oldhead
6338     if {[info exists commitrow($curview,$oldhead)]} {
6339         insertrow $commitrow($curview,$oldhead) $newhead
6340         if {$mainhead ne {}} {
6341             movehead $newhead $mainhead
6342             movedhead $newhead $mainhead
6343         }
6344         redrawtags $oldhead
6345         redrawtags $newhead
6346     }
6347     notbusy cherrypick
6348 }
6349
6350 proc resethead {} {
6351     global mainheadid mainhead rowmenuid confirm_ok resettype
6352
6353     set confirm_ok 0
6354     set w ".confirmreset"
6355     toplevel $w
6356     wm transient $w .
6357     wm title $w [mc "Confirm reset"]
6358     message $w.m -text \
6359         [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
6360         -justify center -aspect 1000
6361     pack $w.m -side top -fill x -padx 20 -pady 20
6362     frame $w.f -relief sunken -border 2
6363     message $w.f.rt -text [mc "Reset type:"] -aspect 1000
6364     grid $w.f.rt -sticky w
6365     set resettype mixed
6366     radiobutton $w.f.soft -value soft -variable resettype -justify left \
6367         -text [mc "Soft: Leave working tree and index untouched"]
6368     grid $w.f.soft -sticky w
6369     radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
6370         -text [mc "Mixed: Leave working tree untouched, reset index"]
6371     grid $w.f.mixed -sticky w
6372     radiobutton $w.f.hard -value hard -variable resettype -justify left \
6373         -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
6374     grid $w.f.hard -sticky w
6375     pack $w.f -side top -fill x
6376     button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
6377     pack $w.ok -side left -fill x -padx 20 -pady 20
6378     button $w.cancel -text [mc Cancel] -command "destroy $w"
6379     pack $w.cancel -side right -fill x -padx 20 -pady 20
6380     bind $w <Visibility> "grab $w; focus $w"
6381     tkwait window $w
6382     if {!$confirm_ok} return
6383     if {[catch {set fd [open \
6384             [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6385         error_popup $err
6386     } else {
6387         dohidelocalchanges
6388         filerun $fd [list readresetstat $fd]
6389         nowbusy reset [mc "Resetting"]
6390     }
6391 }
6392
6393 proc readresetstat {fd} {
6394     global mainhead mainheadid showlocalchanges rprogcoord
6395
6396     if {[gets $fd line] >= 0} {
6397         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
6398             set rprogcoord [expr {1.0 * $m / $n}]
6399             adjustprogress
6400         }
6401         return 1
6402     }
6403     set rprogcoord 0
6404     adjustprogress
6405     notbusy reset
6406     if {[catch {close $fd} err]} {
6407         error_popup $err
6408     }
6409     set oldhead $mainheadid
6410     set newhead [exec git rev-parse HEAD]
6411     if {$newhead ne $oldhead} {
6412         movehead $newhead $mainhead
6413         movedhead $newhead $mainhead
6414         set mainheadid $newhead
6415         redrawtags $oldhead
6416         redrawtags $newhead
6417     }
6418     if {$showlocalchanges} {
6419         doshowlocalchanges
6420     }
6421     return 0
6422 }
6423
6424 # context menu for a head
6425 proc headmenu {x y id head} {
6426     global headmenuid headmenuhead headctxmenu mainhead
6427
6428     stopfinding
6429     set headmenuid $id
6430     set headmenuhead $head
6431     set state normal
6432     if {$head eq $mainhead} {
6433         set state disabled
6434     }
6435     $headctxmenu entryconfigure 0 -state $state
6436     $headctxmenu entryconfigure 1 -state $state
6437     tk_popup $headctxmenu $x $y
6438 }
6439
6440 proc cobranch {} {
6441     global headmenuid headmenuhead mainhead headids
6442     global showlocalchanges mainheadid
6443
6444     # check the tree is clean first??
6445     set oldmainhead $mainhead
6446     nowbusy checkout [mc "Checking out"]
6447     update
6448     dohidelocalchanges
6449     if {[catch {
6450         exec git checkout -q $headmenuhead
6451     } err]} {
6452         notbusy checkout
6453         error_popup $err
6454     } else {
6455         notbusy checkout
6456         set mainhead $headmenuhead
6457         set mainheadid $headmenuid
6458         if {[info exists headids($oldmainhead)]} {
6459             redrawtags $headids($oldmainhead)
6460         }
6461         redrawtags $headmenuid
6462     }
6463     if {$showlocalchanges} {
6464         dodiffindex
6465     }
6466 }
6467
6468 proc rmbranch {} {
6469     global headmenuid headmenuhead mainhead
6470     global idheads
6471
6472     set head $headmenuhead
6473     set id $headmenuid
6474     # this check shouldn't be needed any more...
6475     if {$head eq $mainhead} {
6476         error_popup [mc "Cannot delete the currently checked-out branch"]
6477         return
6478     }
6479     set dheads [descheads $id]
6480     if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
6481         # the stuff on this branch isn't on any other branch
6482         if {![confirm_popup [mc "The commits on branch %s aren't on any other\
6483                         branch.\nReally delete branch %s?" $head $head]]} return
6484     }
6485     nowbusy rmbranch
6486     update
6487     if {[catch {exec git branch -D $head} err]} {
6488         notbusy rmbranch
6489         error_popup $err
6490         return
6491     }
6492     removehead $id $head
6493     removedhead $id $head
6494     redrawtags $id
6495     notbusy rmbranch
6496     dispneartags 0
6497     run refill_reflist
6498 }
6499
6500 # Display a list of tags and heads
6501 proc showrefs {} {
6502     global showrefstop bgcolor fgcolor selectbgcolor
6503     global bglist fglist reflistfilter reflist maincursor
6504
6505     set top .showrefs
6506     set showrefstop $top
6507     if {[winfo exists $top]} {
6508         raise $top
6509         refill_reflist
6510         return
6511     }
6512     toplevel $top
6513     wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
6514     text $top.list -background $bgcolor -foreground $fgcolor \
6515         -selectbackground $selectbgcolor -font mainfont \
6516         -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
6517         -width 30 -height 20 -cursor $maincursor \
6518         -spacing1 1 -spacing3 1 -state disabled
6519     $top.list tag configure highlight -background $selectbgcolor
6520     lappend bglist $top.list
6521     lappend fglist $top.list
6522     scrollbar $top.ysb -command "$top.list yview" -orient vertical
6523     scrollbar $top.xsb -command "$top.list xview" -orient horizontal
6524     grid $top.list $top.ysb -sticky nsew
6525     grid $top.xsb x -sticky ew
6526     frame $top.f
6527     label $top.f.l -text "[mc "Filter"]: "
6528     entry $top.f.e -width 20 -textvariable reflistfilter
6529     set reflistfilter "*"
6530     trace add variable reflistfilter write reflistfilter_change
6531     pack $top.f.e -side right -fill x -expand 1
6532     pack $top.f.l -side left
6533     grid $top.f - -sticky ew -pady 2
6534     button $top.close -command [list destroy $top] -text [mc "Close"]
6535     grid $top.close -
6536     grid columnconfigure $top 0 -weight 1
6537     grid rowconfigure $top 0 -weight 1
6538     bind $top.list <1> {break}
6539     bind $top.list <B1-Motion> {break}
6540     bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
6541     set reflist {}
6542     refill_reflist
6543 }
6544
6545 proc sel_reflist {w x y} {
6546     global showrefstop reflist headids tagids otherrefids
6547
6548     if {![winfo exists $showrefstop]} return
6549     set l [lindex [split [$w index "@$x,$y"] "."] 0]
6550     set ref [lindex $reflist [expr {$l-1}]]
6551     set n [lindex $ref 0]
6552     switch -- [lindex $ref 1] {
6553         "H" {selbyid $headids($n)}
6554         "T" {selbyid $tagids($n)}
6555         "o" {selbyid $otherrefids($n)}
6556     }
6557     $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
6558 }
6559
6560 proc unsel_reflist {} {
6561     global showrefstop
6562
6563     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6564     $showrefstop.list tag remove highlight 0.0 end
6565 }
6566
6567 proc reflistfilter_change {n1 n2 op} {
6568     global reflistfilter
6569
6570     after cancel refill_reflist
6571     after 200 refill_reflist
6572 }
6573
6574 proc refill_reflist {} {
6575     global reflist reflistfilter showrefstop headids tagids otherrefids
6576     global commitrow curview commitinterest
6577
6578     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6579     set refs {}
6580     foreach n [array names headids] {
6581         if {[string match $reflistfilter $n]} {
6582             if {[info exists commitrow($curview,$headids($n))]} {
6583                 lappend refs [list $n H]
6584             } else {
6585                 set commitinterest($headids($n)) {run refill_reflist}
6586             }
6587         }
6588     }
6589     foreach n [array names tagids] {
6590         if {[string match $reflistfilter $n]} {
6591             if {[info exists commitrow($curview,$tagids($n))]} {
6592                 lappend refs [list $n T]
6593             } else {
6594                 set commitinterest($tagids($n)) {run refill_reflist}
6595             }
6596         }
6597     }
6598     foreach n [array names otherrefids] {
6599         if {[string match $reflistfilter $n]} {
6600             if {[info exists commitrow($curview,$otherrefids($n))]} {
6601                 lappend refs [list $n o]
6602             } else {
6603                 set commitinterest($otherrefids($n)) {run refill_reflist}
6604             }
6605         }
6606     }
6607     set refs [lsort -index 0 $refs]
6608     if {$refs eq $reflist} return
6609
6610     # Update the contents of $showrefstop.list according to the
6611     # differences between $reflist (old) and $refs (new)
6612     $showrefstop.list conf -state normal
6613     $showrefstop.list insert end "\n"
6614     set i 0
6615     set j 0
6616     while {$i < [llength $reflist] || $j < [llength $refs]} {
6617         if {$i < [llength $reflist]} {
6618             if {$j < [llength $refs]} {
6619                 set cmp [string compare [lindex $reflist $i 0] \
6620                              [lindex $refs $j 0]]
6621                 if {$cmp == 0} {
6622                     set cmp [string compare [lindex $reflist $i 1] \
6623                                  [lindex $refs $j 1]]
6624                 }
6625             } else {
6626                 set cmp -1
6627             }
6628         } else {
6629             set cmp 1
6630         }
6631         switch -- $cmp {
6632             -1 {
6633                 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
6634                 incr i
6635             }
6636             0 {
6637                 incr i
6638                 incr j
6639             }
6640             1 {
6641                 set l [expr {$j + 1}]
6642                 $showrefstop.list image create $l.0 -align baseline \
6643                     -image reficon-[lindex $refs $j 1] -padx 2
6644                 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
6645                 incr j
6646             }
6647         }
6648     }
6649     set reflist $refs
6650     # delete last newline
6651     $showrefstop.list delete end-2c end-1c
6652     $showrefstop.list conf -state disabled
6653 }
6654
6655 # Stuff for finding nearby tags
6656 proc getallcommits {} {
6657     global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
6658     global idheads idtags idotherrefs allparents tagobjid
6659
6660     if {![info exists allcommits]} {
6661         set nextarc 0
6662         set allcommits 0
6663         set seeds {}
6664         set allcwait 0
6665         set cachedarcs 0
6666         set allccache [file join [gitdir] "gitk.cache"]
6667         if {![catch {
6668             set f [open $allccache r]
6669             set allcwait 1
6670             getcache $f
6671         }]} return
6672     }
6673
6674     if {$allcwait} {
6675         return
6676     }
6677     set cmd [list | git rev-list --parents]
6678     set allcupdate [expr {$seeds ne {}}]
6679     if {!$allcupdate} {
6680         set ids "--all"
6681     } else {
6682         set refs [concat [array names idheads] [array names idtags] \
6683                       [array names idotherrefs]]
6684         set ids {}
6685         set tagobjs {}
6686         foreach name [array names tagobjid] {
6687             lappend tagobjs $tagobjid($name)
6688         }
6689         foreach id [lsort -unique $refs] {
6690             if {![info exists allparents($id)] &&
6691                 [lsearch -exact $tagobjs $id] < 0} {
6692                 lappend ids $id
6693             }
6694         }
6695         if {$ids ne {}} {
6696             foreach id $seeds {
6697                 lappend ids "^$id"
6698             }
6699         }
6700     }
6701     if {$ids ne {}} {
6702         set fd [open [concat $cmd $ids] r]
6703         fconfigure $fd -blocking 0
6704         incr allcommits
6705         nowbusy allcommits
6706         filerun $fd [list getallclines $fd]
6707     } else {
6708         dispneartags 0
6709     }
6710 }
6711
6712 # Since most commits have 1 parent and 1 child, we group strings of
6713 # such commits into "arcs" joining branch/merge points (BMPs), which
6714 # are commits that either don't have 1 parent or don't have 1 child.
6715 #
6716 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6717 # arcout(id) - outgoing arcs for BMP
6718 # arcids(a) - list of IDs on arc including end but not start
6719 # arcstart(a) - BMP ID at start of arc
6720 # arcend(a) - BMP ID at end of arc
6721 # growing(a) - arc a is still growing
6722 # arctags(a) - IDs out of arcids (excluding end) that have tags
6723 # archeads(a) - IDs out of arcids (excluding end) that have heads
6724 # The start of an arc is at the descendent end, so "incoming" means
6725 # coming from descendents, and "outgoing" means going towards ancestors.
6726
6727 proc getallclines {fd} {
6728     global allparents allchildren idtags idheads nextarc
6729     global arcnos arcids arctags arcout arcend arcstart archeads growing
6730     global seeds allcommits cachedarcs allcupdate
6731
6732     set nid 0
6733     while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6734         set id [lindex $line 0]
6735         if {[info exists allparents($id)]} {
6736             # seen it already
6737             continue
6738         }
6739         set cachedarcs 0
6740         set olds [lrange $line 1 end]
6741         set allparents($id) $olds
6742         if {![info exists allchildren($id)]} {
6743             set allchildren($id) {}
6744             set arcnos($id) {}
6745             lappend seeds $id
6746         } else {
6747             set a $arcnos($id)
6748             if {[llength $olds] == 1 && [llength $a] == 1} {
6749                 lappend arcids($a) $id
6750                 if {[info exists idtags($id)]} {
6751                     lappend arctags($a) $id
6752                 }
6753                 if {[info exists idheads($id)]} {
6754                     lappend archeads($a) $id
6755                 }
6756                 if {[info exists allparents($olds)]} {
6757                     # seen parent already
6758                     if {![info exists arcout($olds)]} {
6759                         splitarc $olds
6760                     }
6761                     lappend arcids($a) $olds
6762                     set arcend($a) $olds
6763                     unset growing($a)
6764                 }
6765                 lappend allchildren($olds) $id
6766                 lappend arcnos($olds) $a
6767                 continue
6768             }
6769         }
6770         foreach a $arcnos($id) {
6771             lappend arcids($a) $id
6772             set arcend($a) $id
6773             unset growing($a)
6774         }
6775
6776         set ao {}
6777         foreach p $olds {
6778             lappend allchildren($p) $id
6779             set a [incr nextarc]
6780             set arcstart($a) $id
6781             set archeads($a) {}
6782             set arctags($a) {}
6783             set archeads($a) {}
6784             set arcids($a) {}
6785             lappend ao $a
6786             set growing($a) 1
6787             if {[info exists allparents($p)]} {
6788                 # seen it already, may need to make a new branch
6789                 if {![info exists arcout($p)]} {
6790                     splitarc $p
6791                 }
6792                 lappend arcids($a) $p
6793                 set arcend($a) $p
6794                 unset growing($a)
6795             }
6796             lappend arcnos($p) $a
6797         }
6798         set arcout($id) $ao
6799     }
6800     if {$nid > 0} {
6801         global cached_dheads cached_dtags cached_atags
6802         catch {unset cached_dheads}
6803         catch {unset cached_dtags}
6804         catch {unset cached_atags}
6805     }
6806     if {![eof $fd]} {
6807         return [expr {$nid >= 1000? 2: 1}]
6808     }
6809     set cacheok 1
6810     if {[catch {
6811         fconfigure $fd -blocking 1
6812         close $fd
6813     } err]} {
6814         # got an error reading the list of commits
6815         # if we were updating, try rereading the whole thing again
6816         if {$allcupdate} {
6817             incr allcommits -1
6818             dropcache $err
6819             return
6820         }
6821         error_popup "[mc "Error reading commit topology information;\
6822                 branch and preceding/following tag information\
6823                 will be incomplete."]\n($err)"
6824         set cacheok 0
6825     }
6826     if {[incr allcommits -1] == 0} {
6827         notbusy allcommits
6828         if {$cacheok} {
6829             run savecache
6830         }
6831     }
6832     dispneartags 0
6833     return 0
6834 }
6835
6836 proc recalcarc {a} {
6837     global arctags archeads arcids idtags idheads
6838
6839     set at {}
6840     set ah {}
6841     foreach id [lrange $arcids($a) 0 end-1] {
6842         if {[info exists idtags($id)]} {
6843             lappend at $id
6844         }
6845         if {[info exists idheads($id)]} {
6846             lappend ah $id
6847         }
6848     }
6849     set arctags($a) $at
6850     set archeads($a) $ah
6851 }
6852
6853 proc splitarc {p} {
6854     global arcnos arcids nextarc arctags archeads idtags idheads
6855     global arcstart arcend arcout allparents growing
6856
6857     set a $arcnos($p)
6858     if {[llength $a] != 1} {
6859         puts "oops splitarc called but [llength $a] arcs already"
6860         return
6861     }
6862     set a [lindex $a 0]
6863     set i [lsearch -exact $arcids($a) $p]
6864     if {$i < 0} {
6865         puts "oops splitarc $p not in arc $a"
6866         return
6867     }
6868     set na [incr nextarc]
6869     if {[info exists arcend($a)]} {
6870         set arcend($na) $arcend($a)
6871     } else {
6872         set l [lindex $allparents([lindex $arcids($a) end]) 0]
6873         set j [lsearch -exact $arcnos($l) $a]
6874         set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6875     }
6876     set tail [lrange $arcids($a) [expr {$i+1}] end]
6877     set arcids($a) [lrange $arcids($a) 0 $i]
6878     set arcend($a) $p
6879     set arcstart($na) $p
6880     set arcout($p) $na
6881     set arcids($na) $tail
6882     if {[info exists growing($a)]} {
6883         set growing($na) 1
6884         unset growing($a)
6885     }
6886
6887     foreach id $tail {
6888         if {[llength $arcnos($id)] == 1} {
6889             set arcnos($id) $na
6890         } else {
6891             set j [lsearch -exact $arcnos($id) $a]
6892             set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6893         }
6894     }
6895
6896     # reconstruct tags and heads lists
6897     if {$arctags($a) ne {} || $archeads($a) ne {}} {
6898         recalcarc $a
6899         recalcarc $na
6900     } else {
6901         set arctags($na) {}
6902         set archeads($na) {}
6903     }
6904 }
6905
6906 # Update things for a new commit added that is a child of one
6907 # existing commit.  Used when cherry-picking.
6908 proc addnewchild {id p} {
6909     global allparents allchildren idtags nextarc
6910     global arcnos arcids arctags arcout arcend arcstart archeads growing
6911     global seeds allcommits
6912
6913     if {![info exists allcommits] || ![info exists arcnos($p)]} return
6914     set allparents($id) [list $p]
6915     set allchildren($id) {}
6916     set arcnos($id) {}
6917     lappend seeds $id
6918     lappend allchildren($p) $id
6919     set a [incr nextarc]
6920     set arcstart($a) $id
6921     set archeads($a) {}
6922     set arctags($a) {}
6923     set arcids($a) [list $p]
6924     set arcend($a) $p
6925     if {![info exists arcout($p)]} {
6926         splitarc $p
6927     }
6928     lappend arcnos($p) $a
6929     set arcout($id) [list $a]
6930 }
6931
6932 # This implements a cache for the topology information.
6933 # The cache saves, for each arc, the start and end of the arc,
6934 # the ids on the arc, and the outgoing arcs from the end.
6935 proc readcache {f} {
6936     global arcnos arcids arcout arcstart arcend arctags archeads nextarc
6937     global idtags idheads allparents cachedarcs possible_seeds seeds growing
6938     global allcwait
6939
6940     set a $nextarc
6941     set lim $cachedarcs
6942     if {$lim - $a > 500} {
6943         set lim [expr {$a + 500}]
6944     }
6945     if {[catch {
6946         if {$a == $lim} {
6947             # finish reading the cache and setting up arctags, etc.
6948             set line [gets $f]
6949             if {$line ne "1"} {error "bad final version"}
6950             close $f
6951             foreach id [array names idtags] {
6952                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
6953                     [llength $allparents($id)] == 1} {
6954                     set a [lindex $arcnos($id) 0]
6955                     if {$arctags($a) eq {}} {
6956                         recalcarc $a
6957                     }
6958                 }
6959             }
6960             foreach id [array names idheads] {
6961                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
6962                     [llength $allparents($id)] == 1} {
6963                     set a [lindex $arcnos($id) 0]
6964                     if {$archeads($a) eq {}} {
6965                         recalcarc $a
6966                     }
6967                 }
6968             }
6969             foreach id [lsort -unique $possible_seeds] {
6970                 if {$arcnos($id) eq {}} {
6971                     lappend seeds $id
6972                 }
6973             }
6974             set allcwait 0
6975         } else {
6976             while {[incr a] <= $lim} {
6977                 set line [gets $f]
6978                 if {[llength $line] != 3} {error "bad line"}
6979                 set s [lindex $line 0]
6980                 set arcstart($a) $s
6981                 lappend arcout($s) $a
6982                 if {![info exists arcnos($s)]} {
6983                     lappend possible_seeds $s
6984                     set arcnos($s) {}
6985                 }
6986                 set e [lindex $line 1]
6987                 if {$e eq {}} {
6988                     set growing($a) 1
6989                 } else {
6990                     set arcend($a) $e
6991                     if {![info exists arcout($e)]} {
6992                         set arcout($e) {}
6993                     }
6994                 }
6995                 set arcids($a) [lindex $line 2]
6996                 foreach id $arcids($a) {
6997                     lappend allparents($s) $id
6998                     set s $id
6999                     lappend arcnos($id) $a
7000                 }
7001                 if {![info exists allparents($s)]} {
7002                     set allparents($s) {}
7003                 }
7004                 set arctags($a) {}
7005                 set archeads($a) {}
7006             }
7007             set nextarc [expr {$a - 1}]
7008         }
7009     } err]} {
7010         dropcache $err
7011         return 0
7012     }
7013     if {!$allcwait} {
7014         getallcommits
7015     }
7016     return $allcwait
7017 }
7018
7019 proc getcache {f} {
7020     global nextarc cachedarcs possible_seeds
7021
7022     if {[catch {
7023         set line [gets $f]
7024         if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
7025         # make sure it's an integer
7026         set cachedarcs [expr {int([lindex $line 1])}]
7027         if {$cachedarcs < 0} {error "bad number of arcs"}
7028         set nextarc 0
7029         set possible_seeds {}
7030         run readcache $f
7031     } err]} {
7032         dropcache $err
7033     }
7034     return 0
7035 }
7036
7037 proc dropcache {err} {
7038     global allcwait nextarc cachedarcs seeds
7039
7040     #puts "dropping cache ($err)"
7041     foreach v {arcnos arcout arcids arcstart arcend growing \
7042                    arctags archeads allparents allchildren} {
7043         global $v
7044         catch {unset $v}
7045     }
7046     set allcwait 0
7047     set nextarc 0
7048     set cachedarcs 0
7049     set seeds {}
7050     getallcommits
7051 }
7052
7053 proc writecache {f} {
7054     global cachearc cachedarcs allccache
7055     global arcstart arcend arcnos arcids arcout
7056
7057     set a $cachearc
7058     set lim $cachedarcs
7059     if {$lim - $a > 1000} {
7060         set lim [expr {$a + 1000}]
7061     }
7062     if {[catch {
7063         while {[incr a] <= $lim} {
7064             if {[info exists arcend($a)]} {
7065                 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
7066             } else {
7067                 puts $f [list $arcstart($a) {} $arcids($a)]
7068             }
7069         }
7070     } err]} {
7071         catch {close $f}
7072         catch {file delete $allccache}
7073         #puts "writing cache failed ($err)"
7074         return 0
7075     }
7076     set cachearc [expr {$a - 1}]
7077     if {$a > $cachedarcs} {
7078         puts $f "1"
7079         close $f
7080         return 0
7081     }
7082     return 1
7083 }
7084
7085 proc savecache {} {
7086     global nextarc cachedarcs cachearc allccache
7087
7088     if {$nextarc == $cachedarcs} return
7089     set cachearc 0
7090     set cachedarcs $nextarc
7091     catch {
7092         set f [open $allccache w]
7093         puts $f [list 1 $cachedarcs]
7094         run writecache $f
7095     }
7096 }
7097
7098 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
7099 # or 0 if neither is true.
7100 proc anc_or_desc {a b} {
7101     global arcout arcstart arcend arcnos cached_isanc
7102
7103     if {$arcnos($a) eq $arcnos($b)} {
7104         # Both are on the same arc(s); either both are the same BMP,
7105         # or if one is not a BMP, the other is also not a BMP or is
7106         # the BMP at end of the arc (and it only has 1 incoming arc).
7107         # Or both can be BMPs with no incoming arcs.
7108         if {$a eq $b || $arcnos($a) eq {}} {
7109             return 0
7110         }
7111         # assert {[llength $arcnos($a)] == 1}
7112         set arc [lindex $arcnos($a) 0]
7113         set i [lsearch -exact $arcids($arc) $a]
7114         set j [lsearch -exact $arcids($arc) $b]
7115         if {$i < 0 || $i > $j} {
7116             return 1
7117         } else {
7118             return -1
7119         }
7120     }
7121
7122     if {![info exists arcout($a)]} {
7123         set arc [lindex $arcnos($a) 0]
7124         if {[info exists arcend($arc)]} {
7125             set aend $arcend($arc)
7126         } else {
7127             set aend {}
7128         }
7129         set a $arcstart($arc)
7130     } else {
7131         set aend $a
7132     }
7133     if {![info exists arcout($b)]} {
7134         set arc [lindex $arcnos($b) 0]
7135         if {[info exists arcend($arc)]} {
7136             set bend $arcend($arc)
7137         } else {
7138             set bend {}
7139         }
7140         set b $arcstart($arc)
7141     } else {
7142         set bend $b
7143     }
7144     if {$a eq $bend} {
7145         return 1
7146     }
7147     if {$b eq $aend} {
7148         return -1
7149     }
7150     if {[info exists cached_isanc($a,$bend)]} {
7151         if {$cached_isanc($a,$bend)} {
7152             return 1
7153         }
7154     }
7155     if {[info exists cached_isanc($b,$aend)]} {
7156         if {$cached_isanc($b,$aend)} {
7157             return -1
7158         }
7159         if {[info exists cached_isanc($a,$bend)]} {
7160             return 0
7161         }
7162     }
7163
7164     set todo [list $a $b]
7165     set anc($a) a
7166     set anc($b) b
7167     for {set i 0} {$i < [llength $todo]} {incr i} {
7168         set x [lindex $todo $i]
7169         if {$anc($x) eq {}} {
7170             continue
7171         }
7172         foreach arc $arcnos($x) {
7173             set xd $arcstart($arc)
7174             if {$xd eq $bend} {
7175                 set cached_isanc($a,$bend) 1
7176                 set cached_isanc($b,$aend) 0
7177                 return 1
7178             } elseif {$xd eq $aend} {
7179                 set cached_isanc($b,$aend) 1
7180                 set cached_isanc($a,$bend) 0
7181                 return -1
7182             }
7183             if {![info exists anc($xd)]} {
7184                 set anc($xd) $anc($x)
7185                 lappend todo $xd
7186             } elseif {$anc($xd) ne $anc($x)} {
7187                 set anc($xd) {}
7188             }
7189         }
7190     }
7191     set cached_isanc($a,$bend) 0
7192     set cached_isanc($b,$aend) 0
7193     return 0
7194 }
7195
7196 # This identifies whether $desc has an ancestor that is
7197 # a growing tip of the graph and which is not an ancestor of $anc
7198 # and returns 0 if so and 1 if not.
7199 # If we subsequently discover a tag on such a growing tip, and that
7200 # turns out to be a descendent of $anc (which it could, since we
7201 # don't necessarily see children before parents), then $desc
7202 # isn't a good choice to display as a descendent tag of
7203 # $anc (since it is the descendent of another tag which is
7204 # a descendent of $anc).  Similarly, $anc isn't a good choice to
7205 # display as a ancestor tag of $desc.
7206 #
7207 proc is_certain {desc anc} {
7208     global arcnos arcout arcstart arcend growing problems
7209
7210     set certain {}
7211     if {[llength $arcnos($anc)] == 1} {
7212         # tags on the same arc are certain
7213         if {$arcnos($desc) eq $arcnos($anc)} {
7214             return 1
7215         }
7216         if {![info exists arcout($anc)]} {
7217             # if $anc is partway along an arc, use the start of the arc instead
7218             set a [lindex $arcnos($anc) 0]
7219             set anc $arcstart($a)
7220         }
7221     }
7222     if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
7223         set x $desc
7224     } else {
7225         set a [lindex $arcnos($desc) 0]
7226         set x $arcend($a)
7227     }
7228     if {$x == $anc} {
7229         return 1
7230     }
7231     set anclist [list $x]
7232     set dl($x) 1
7233     set nnh 1
7234     set ngrowanc 0
7235     for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
7236         set x [lindex $anclist $i]
7237         if {$dl($x)} {
7238             incr nnh -1
7239         }
7240         set done($x) 1
7241         foreach a $arcout($x) {
7242             if {[info exists growing($a)]} {
7243                 if {![info exists growanc($x)] && $dl($x)} {
7244                     set growanc($x) 1
7245                     incr ngrowanc
7246                 }
7247             } else {
7248                 set y $arcend($a)
7249                 if {[info exists dl($y)]} {
7250                     if {$dl($y)} {
7251                         if {!$dl($x)} {
7252                             set dl($y) 0
7253                             if {![info exists done($y)]} {
7254                                 incr nnh -1
7255                             }
7256                             if {[info exists growanc($x)]} {
7257                                 incr ngrowanc -1
7258                             }
7259                             set xl [list $y]
7260                             for {set k 0} {$k < [llength $xl]} {incr k} {
7261                                 set z [lindex $xl $k]
7262                                 foreach c $arcout($z) {
7263                                     if {[info exists arcend($c)]} {
7264                                         set v $arcend($c)
7265                                         if {[info exists dl($v)] && $dl($v)} {
7266                                             set dl($v) 0
7267                                             if {![info exists done($v)]} {
7268                                                 incr nnh -1
7269                                             }
7270                                             if {[info exists growanc($v)]} {
7271                                                 incr ngrowanc -1
7272                                             }
7273                                             lappend xl $v
7274                                         }
7275                                     }
7276                                 }
7277                             }
7278                         }
7279                     }
7280                 } elseif {$y eq $anc || !$dl($x)} {
7281                     set dl($y) 0
7282                     lappend anclist $y
7283                 } else {
7284                     set dl($y) 1
7285                     lappend anclist $y
7286                     incr nnh
7287                 }
7288             }
7289         }
7290     }
7291     foreach x [array names growanc] {
7292         if {$dl($x)} {
7293             return 0
7294         }
7295         return 0
7296     }
7297     return 1
7298 }
7299
7300 proc validate_arctags {a} {
7301     global arctags idtags
7302
7303     set i -1
7304     set na $arctags($a)
7305     foreach id $arctags($a) {
7306         incr i
7307         if {![info exists idtags($id)]} {
7308             set na [lreplace $na $i $i]
7309             incr i -1
7310         }
7311     }
7312     set arctags($a) $na
7313 }
7314
7315 proc validate_archeads {a} {
7316     global archeads idheads
7317
7318     set i -1
7319     set na $archeads($a)
7320     foreach id $archeads($a) {
7321         incr i
7322         if {![info exists idheads($id)]} {
7323             set na [lreplace $na $i $i]
7324             incr i -1
7325         }
7326     }
7327     set archeads($a) $na
7328 }
7329
7330 # Return the list of IDs that have tags that are descendents of id,
7331 # ignoring IDs that are descendents of IDs already reported.
7332 proc desctags {id} {
7333     global arcnos arcstart arcids arctags idtags allparents
7334     global growing cached_dtags
7335
7336     if {![info exists allparents($id)]} {
7337         return {}
7338     }
7339     set t1 [clock clicks -milliseconds]
7340     set argid $id
7341     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7342         # part-way along an arc; check that arc first
7343         set a [lindex $arcnos($id) 0]
7344         if {$arctags($a) ne {}} {
7345             validate_arctags $a
7346             set i [lsearch -exact $arcids($a) $id]
7347             set tid {}
7348             foreach t $arctags($a) {
7349                 set j [lsearch -exact $arcids($a) $t]
7350                 if {$j >= $i} break
7351                 set tid $t
7352             }
7353             if {$tid ne {}} {
7354                 return $tid
7355             }
7356         }
7357         set id $arcstart($a)
7358         if {[info exists idtags($id)]} {
7359             return $id
7360         }
7361     }
7362     if {[info exists cached_dtags($id)]} {
7363         return $cached_dtags($id)
7364     }
7365
7366     set origid $id
7367     set todo [list $id]
7368     set queued($id) 1
7369     set nc 1
7370     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7371         set id [lindex $todo $i]
7372         set done($id) 1
7373         set ta [info exists hastaggedancestor($id)]
7374         if {!$ta} {
7375             incr nc -1
7376         }
7377         # ignore tags on starting node
7378         if {!$ta && $i > 0} {
7379             if {[info exists idtags($id)]} {
7380                 set tagloc($id) $id
7381                 set ta 1
7382             } elseif {[info exists cached_dtags($id)]} {
7383                 set tagloc($id) $cached_dtags($id)
7384                 set ta 1
7385             }
7386         }
7387         foreach a $arcnos($id) {
7388             set d $arcstart($a)
7389             if {!$ta && $arctags($a) ne {}} {
7390                 validate_arctags $a
7391                 if {$arctags($a) ne {}} {
7392                     lappend tagloc($id) [lindex $arctags($a) end]
7393                 }
7394             }
7395             if {$ta || $arctags($a) ne {}} {
7396                 set tomark [list $d]
7397                 for {set j 0} {$j < [llength $tomark]} {incr j} {
7398                     set dd [lindex $tomark $j]
7399                     if {![info exists hastaggedancestor($dd)]} {
7400                         if {[info exists done($dd)]} {
7401                             foreach b $arcnos($dd) {
7402                                 lappend tomark $arcstart($b)
7403                             }
7404                             if {[info exists tagloc($dd)]} {
7405                                 unset tagloc($dd)
7406                             }
7407                         } elseif {[info exists queued($dd)]} {
7408                             incr nc -1
7409                         }
7410                         set hastaggedancestor($dd) 1
7411                     }
7412                 }
7413             }
7414             if {![info exists queued($d)]} {
7415                 lappend todo $d
7416                 set queued($d) 1
7417                 if {![info exists hastaggedancestor($d)]} {
7418                     incr nc
7419                 }
7420             }
7421         }
7422     }
7423     set tags {}
7424     foreach id [array names tagloc] {
7425         if {![info exists hastaggedancestor($id)]} {
7426             foreach t $tagloc($id) {
7427                 if {[lsearch -exact $tags $t] < 0} {
7428                     lappend tags $t
7429                 }
7430             }
7431         }
7432     }
7433     set t2 [clock clicks -milliseconds]
7434     set loopix $i
7435
7436     # remove tags that are descendents of other tags
7437     for {set i 0} {$i < [llength $tags]} {incr i} {
7438         set a [lindex $tags $i]
7439         for {set j 0} {$j < $i} {incr j} {
7440             set b [lindex $tags $j]
7441             set r [anc_or_desc $a $b]
7442             if {$r == 1} {
7443                 set tags [lreplace $tags $j $j]
7444                 incr j -1
7445                 incr i -1
7446             } elseif {$r == -1} {
7447                 set tags [lreplace $tags $i $i]
7448                 incr i -1
7449                 break
7450             }
7451         }
7452     }
7453
7454     if {[array names growing] ne {}} {
7455         # graph isn't finished, need to check if any tag could get
7456         # eclipsed by another tag coming later.  Simply ignore any
7457         # tags that could later get eclipsed.
7458         set ctags {}
7459         foreach t $tags {
7460             if {[is_certain $t $origid]} {
7461                 lappend ctags $t
7462             }
7463         }
7464         if {$tags eq $ctags} {
7465             set cached_dtags($origid) $tags
7466         } else {
7467             set tags $ctags
7468         }
7469     } else {
7470         set cached_dtags($origid) $tags
7471     }
7472     set t3 [clock clicks -milliseconds]
7473     if {0 && $t3 - $t1 >= 100} {
7474         puts "iterating descendents ($loopix/[llength $todo] nodes) took\
7475             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7476     }
7477     return $tags
7478 }
7479
7480 proc anctags {id} {
7481     global arcnos arcids arcout arcend arctags idtags allparents
7482     global growing cached_atags
7483
7484     if {![info exists allparents($id)]} {
7485         return {}
7486     }
7487     set t1 [clock clicks -milliseconds]
7488     set argid $id
7489     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7490         # part-way along an arc; check that arc first
7491         set a [lindex $arcnos($id) 0]
7492         if {$arctags($a) ne {}} {
7493             validate_arctags $a
7494             set i [lsearch -exact $arcids($a) $id]
7495             foreach t $arctags($a) {
7496                 set j [lsearch -exact $arcids($a) $t]
7497                 if {$j > $i} {
7498                     return $t
7499                 }
7500             }
7501         }
7502         if {![info exists arcend($a)]} {
7503             return {}
7504         }
7505         set id $arcend($a)
7506         if {[info exists idtags($id)]} {
7507             return $id
7508         }
7509     }
7510     if {[info exists cached_atags($id)]} {
7511         return $cached_atags($id)
7512     }
7513
7514     set origid $id
7515     set todo [list $id]
7516     set queued($id) 1
7517     set taglist {}
7518     set nc 1
7519     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7520         set id [lindex $todo $i]
7521         set done($id) 1
7522         set td [info exists hastaggeddescendent($id)]
7523         if {!$td} {
7524             incr nc -1
7525         }
7526         # ignore tags on starting node
7527         if {!$td && $i > 0} {
7528             if {[info exists idtags($id)]} {
7529                 set tagloc($id) $id
7530                 set td 1
7531             } elseif {[info exists cached_atags($id)]} {
7532                 set tagloc($id) $cached_atags($id)
7533                 set td 1
7534             }
7535         }
7536         foreach a $arcout($id) {
7537             if {!$td && $arctags($a) ne {}} {
7538                 validate_arctags $a
7539                 if {$arctags($a) ne {}} {
7540                     lappend tagloc($id) [lindex $arctags($a) 0]
7541                 }
7542             }
7543             if {![info exists arcend($a)]} continue
7544             set d $arcend($a)
7545             if {$td || $arctags($a) ne {}} {
7546                 set tomark [list $d]
7547                 for {set j 0} {$j < [llength $tomark]} {incr j} {
7548                     set dd [lindex $tomark $j]
7549                     if {![info exists hastaggeddescendent($dd)]} {
7550                         if {[info exists done($dd)]} {
7551                             foreach b $arcout($dd) {
7552                                 if {[info exists arcend($b)]} {
7553                                     lappend tomark $arcend($b)
7554                                 }
7555                             }
7556                             if {[info exists tagloc($dd)]} {
7557                                 unset tagloc($dd)
7558                             }
7559                         } elseif {[info exists queued($dd)]} {
7560                             incr nc -1
7561                         }
7562                         set hastaggeddescendent($dd) 1
7563                     }
7564                 }
7565             }
7566             if {![info exists queued($d)]} {
7567                 lappend todo $d
7568                 set queued($d) 1
7569                 if {![info exists hastaggeddescendent($d)]} {
7570                     incr nc
7571                 }
7572             }
7573         }
7574     }
7575     set t2 [clock clicks -milliseconds]
7576     set loopix $i
7577     set tags {}
7578     foreach id [array names tagloc] {
7579         if {![info exists hastaggeddescendent($id)]} {
7580             foreach t $tagloc($id) {
7581                 if {[lsearch -exact $tags $t] < 0} {
7582                     lappend tags $t
7583                 }
7584             }
7585         }
7586     }
7587
7588     # remove tags that are ancestors of other tags
7589     for {set i 0} {$i < [llength $tags]} {incr i} {
7590         set a [lindex $tags $i]
7591         for {set j 0} {$j < $i} {incr j} {
7592             set b [lindex $tags $j]
7593             set r [anc_or_desc $a $b]
7594             if {$r == -1} {
7595                 set tags [lreplace $tags $j $j]
7596                 incr j -1
7597                 incr i -1
7598             } elseif {$r == 1} {
7599                 set tags [lreplace $tags $i $i]
7600                 incr i -1
7601                 break
7602             }
7603         }
7604     }
7605
7606     if {[array names growing] ne {}} {
7607         # graph isn't finished, need to check if any tag could get
7608         # eclipsed by another tag coming later.  Simply ignore any
7609         # tags that could later get eclipsed.
7610         set ctags {}
7611         foreach t $tags {
7612             if {[is_certain $origid $t]} {
7613                 lappend ctags $t
7614             }
7615         }
7616         if {$tags eq $ctags} {
7617             set cached_atags($origid) $tags
7618         } else {
7619             set tags $ctags
7620         }
7621     } else {
7622         set cached_atags($origid) $tags
7623     }
7624     set t3 [clock clicks -milliseconds]
7625     if {0 && $t3 - $t1 >= 100} {
7626         puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
7627             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7628     }
7629     return $tags
7630 }
7631
7632 # Return the list of IDs that have heads that are descendents of id,
7633 # including id itself if it has a head.
7634 proc descheads {id} {
7635     global arcnos arcstart arcids archeads idheads cached_dheads
7636     global allparents
7637
7638     if {![info exists allparents($id)]} {
7639         return {}
7640     }
7641     set aret {}
7642     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7643         # part-way along an arc; check it first
7644         set a [lindex $arcnos($id) 0]
7645         if {$archeads($a) ne {}} {
7646             validate_archeads $a
7647             set i [lsearch -exact $arcids($a) $id]
7648             foreach t $archeads($a) {
7649                 set j [lsearch -exact $arcids($a) $t]
7650                 if {$j > $i} break
7651                 lappend aret $t
7652             }
7653         }
7654         set id $arcstart($a)
7655     }
7656     set origid $id
7657     set todo [list $id]
7658     set seen($id) 1
7659     set ret {}
7660     for {set i 0} {$i < [llength $todo]} {incr i} {
7661         set id [lindex $todo $i]
7662         if {[info exists cached_dheads($id)]} {
7663             set ret [concat $ret $cached_dheads($id)]
7664         } else {
7665             if {[info exists idheads($id)]} {
7666                 lappend ret $id
7667             }
7668             foreach a $arcnos($id) {
7669                 if {$archeads($a) ne {}} {
7670                     validate_archeads $a
7671                     if {$archeads($a) ne {}} {
7672                         set ret [concat $ret $archeads($a)]
7673                     }
7674                 }
7675                 set d $arcstart($a)
7676                 if {![info exists seen($d)]} {
7677                     lappend todo $d
7678                     set seen($d) 1
7679                 }
7680             }
7681         }
7682     }
7683     set ret [lsort -unique $ret]
7684     set cached_dheads($origid) $ret
7685     return [concat $ret $aret]
7686 }
7687
7688 proc addedtag {id} {
7689     global arcnos arcout cached_dtags cached_atags
7690
7691     if {![info exists arcnos($id)]} return
7692     if {![info exists arcout($id)]} {
7693         recalcarc [lindex $arcnos($id) 0]
7694     }
7695     catch {unset cached_dtags}
7696     catch {unset cached_atags}
7697 }
7698
7699 proc addedhead {hid head} {
7700     global arcnos arcout cached_dheads
7701
7702     if {![info exists arcnos($hid)]} return
7703     if {![info exists arcout($hid)]} {
7704         recalcarc [lindex $arcnos($hid) 0]
7705     }
7706     catch {unset cached_dheads}
7707 }
7708
7709 proc removedhead {hid head} {
7710     global cached_dheads
7711
7712     catch {unset cached_dheads}
7713 }
7714
7715 proc movedhead {hid head} {
7716     global arcnos arcout cached_dheads
7717
7718     if {![info exists arcnos($hid)]} return
7719     if {![info exists arcout($hid)]} {
7720         recalcarc [lindex $arcnos($hid) 0]
7721     }
7722     catch {unset cached_dheads}
7723 }
7724
7725 proc changedrefs {} {
7726     global cached_dheads cached_dtags cached_atags
7727     global arctags archeads arcnos arcout idheads idtags
7728
7729     foreach id [concat [array names idheads] [array names idtags]] {
7730         if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
7731             set a [lindex $arcnos($id) 0]
7732             if {![info exists donearc($a)]} {
7733                 recalcarc $a
7734                 set donearc($a) 1
7735             }
7736         }
7737     }
7738     catch {unset cached_dtags}
7739     catch {unset cached_atags}
7740     catch {unset cached_dheads}
7741 }
7742
7743 proc rereadrefs {} {
7744     global idtags idheads idotherrefs mainhead
7745
7746     set refids [concat [array names idtags] \
7747                     [array names idheads] [array names idotherrefs]]
7748     foreach id $refids {
7749         if {![info exists ref($id)]} {
7750             set ref($id) [listrefs $id]
7751         }
7752     }
7753     set oldmainhead $mainhead
7754     readrefs
7755     changedrefs
7756     set refids [lsort -unique [concat $refids [array names idtags] \
7757                         [array names idheads] [array names idotherrefs]]]
7758     foreach id $refids {
7759         set v [listrefs $id]
7760         if {![info exists ref($id)] || $ref($id) != $v ||
7761             ($id eq $oldmainhead && $id ne $mainhead) ||
7762             ($id eq $mainhead && $id ne $oldmainhead)} {
7763             redrawtags $id
7764         }
7765     }
7766     run refill_reflist
7767 }
7768
7769 proc listrefs {id} {
7770     global idtags idheads idotherrefs
7771
7772     set x {}
7773     if {[info exists idtags($id)]} {
7774         set x $idtags($id)
7775     }
7776     set y {}
7777     if {[info exists idheads($id)]} {
7778         set y $idheads($id)
7779     }
7780     set z {}
7781     if {[info exists idotherrefs($id)]} {
7782         set z $idotherrefs($id)
7783     }
7784     return [list $x $y $z]
7785 }
7786
7787 proc showtag {tag isnew} {
7788     global ctext tagcontents tagids linknum tagobjid
7789
7790     if {$isnew} {
7791         addtohistory [list showtag $tag 0]
7792     }
7793     $ctext conf -state normal
7794     clear_ctext
7795     settabs 0
7796     set linknum 0
7797     if {![info exists tagcontents($tag)]} {
7798         catch {
7799             set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
7800         }
7801     }
7802     if {[info exists tagcontents($tag)]} {
7803         set text $tagcontents($tag)
7804     } else {
7805         set text "[mc "Tag"]: $tag\n[mc "Id"]:  $tagids($tag)"
7806     }
7807     appendwithlinks $text {}
7808     $ctext conf -state disabled
7809     init_flist {}
7810 }
7811
7812 proc doquit {} {
7813     global stopped
7814     set stopped 100
7815     savestuff .
7816     destroy .
7817 }
7818
7819 proc mkfontdisp {font top which} {
7820     global fontattr fontpref $font
7821
7822     set fontpref($font) [set $font]
7823     button $top.${font}but -text $which -font optionfont \
7824         -command [list choosefont $font $which]
7825     label $top.$font -relief flat -font $font \
7826         -text $fontattr($font,family) -justify left
7827     grid x $top.${font}but $top.$font -sticky w
7828 }
7829
7830 proc choosefont {font which} {
7831     global fontparam fontlist fonttop fontattr
7832
7833     set fontparam(which) $which
7834     set fontparam(font) $font
7835     set fontparam(family) [font actual $font -family]
7836     set fontparam(size) $fontattr($font,size)
7837     set fontparam(weight) $fontattr($font,weight)
7838     set fontparam(slant) $fontattr($font,slant)
7839     set top .gitkfont
7840     set fonttop $top
7841     if {![winfo exists $top]} {
7842         font create sample
7843         eval font config sample [font actual $font]
7844         toplevel $top
7845         wm title $top [mc "Gitk font chooser"]
7846         label $top.l -textvariable fontparam(which)
7847         pack $top.l -side top
7848         set fontlist [lsort [font families]]
7849         frame $top.f
7850         listbox $top.f.fam -listvariable fontlist \
7851             -yscrollcommand [list $top.f.sb set]
7852         bind $top.f.fam <<ListboxSelect>> selfontfam
7853         scrollbar $top.f.sb -command [list $top.f.fam yview]
7854         pack $top.f.sb -side right -fill y
7855         pack $top.f.fam -side left -fill both -expand 1
7856         pack $top.f -side top -fill both -expand 1
7857         frame $top.g
7858         spinbox $top.g.size -from 4 -to 40 -width 4 \
7859             -textvariable fontparam(size) \
7860             -validatecommand {string is integer -strict %s}
7861         checkbutton $top.g.bold -padx 5 \
7862             -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
7863             -variable fontparam(weight) -onvalue bold -offvalue normal
7864         checkbutton $top.g.ital -padx 5 \
7865             -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
7866             -variable fontparam(slant) -onvalue italic -offvalue roman
7867         pack $top.g.size $top.g.bold $top.g.ital -side left
7868         pack $top.g -side top
7869         canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
7870             -background white
7871         $top.c create text 100 25 -anchor center -text $which -font sample \
7872             -fill black -tags text
7873         bind $top.c <Configure> [list centertext $top.c]
7874         pack $top.c -side top -fill x
7875         frame $top.buts
7876         button $top.buts.ok -text [mc "OK"] -command fontok -default active
7877         button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
7878         grid $top.buts.ok $top.buts.can
7879         grid columnconfigure $top.buts 0 -weight 1 -uniform a
7880         grid columnconfigure $top.buts 1 -weight 1 -uniform a
7881         pack $top.buts -side bottom -fill x
7882         trace add variable fontparam write chg_fontparam
7883     } else {
7884         raise $top
7885         $top.c itemconf text -text $which
7886     }
7887     set i [lsearch -exact $fontlist $fontparam(family)]
7888     if {$i >= 0} {
7889         $top.f.fam selection set $i
7890         $top.f.fam see $i
7891     }
7892 }
7893
7894 proc centertext {w} {
7895     $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
7896 }
7897
7898 proc fontok {} {
7899     global fontparam fontpref prefstop
7900
7901     set f $fontparam(font)
7902     set fontpref($f) [list $fontparam(family) $fontparam(size)]
7903     if {$fontparam(weight) eq "bold"} {
7904         lappend fontpref($f) "bold"
7905     }
7906     if {$fontparam(slant) eq "italic"} {
7907         lappend fontpref($f) "italic"
7908     }
7909     set w $prefstop.$f
7910     $w conf -text $fontparam(family) -font $fontpref($f)
7911
7912     fontcan
7913 }
7914
7915 proc fontcan {} {
7916     global fonttop fontparam
7917
7918     if {[info exists fonttop]} {
7919         catch {destroy $fonttop}
7920         catch {font delete sample}
7921         unset fonttop
7922         unset fontparam
7923     }
7924 }
7925
7926 proc selfontfam {} {
7927     global fonttop fontparam
7928
7929     set i [$fonttop.f.fam curselection]
7930     if {$i ne {}} {
7931         set fontparam(family) [$fonttop.f.fam get $i]
7932     }
7933 }
7934
7935 proc chg_fontparam {v sub op} {
7936     global fontparam
7937
7938     font config sample -$sub $fontparam($sub)
7939 }
7940
7941 proc doprefs {} {
7942     global maxwidth maxgraphpct
7943     global oldprefs prefstop showneartags showlocalchanges
7944     global bgcolor fgcolor ctext diffcolors selectbgcolor
7945     global tabstop limitdiffs
7946
7947     set top .gitkprefs
7948     set prefstop $top
7949     if {[winfo exists $top]} {
7950         raise $top
7951         return
7952     }
7953     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
7954                    limitdiffs tabstop} {
7955         set oldprefs($v) [set $v]
7956     }
7957     toplevel $top
7958     wm title $top [mc "Gitk preferences"]
7959     label $top.ldisp -text [mc "Commit list display options"]
7960     grid $top.ldisp - -sticky w -pady 10
7961     label $top.spacer -text " "
7962     label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
7963         -font optionfont
7964     spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7965     grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7966     label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
7967         -font optionfont
7968     spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7969     grid x $top.maxpctl $top.maxpct -sticky w
7970     frame $top.showlocal
7971     label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
7972     checkbutton $top.showlocal.b -variable showlocalchanges
7973     pack $top.showlocal.b $top.showlocal.l -side left
7974     grid x $top.showlocal -sticky w
7975
7976     label $top.ddisp -text [mc "Diff display options"]
7977     grid $top.ddisp - -sticky w -pady 10
7978     label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
7979     spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7980     grid x $top.tabstopl $top.tabstop -sticky w
7981     frame $top.ntag
7982     label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
7983     checkbutton $top.ntag.b -variable showneartags
7984     pack $top.ntag.b $top.ntag.l -side left
7985     grid x $top.ntag -sticky w
7986     frame $top.ldiff
7987     label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
7988     checkbutton $top.ldiff.b -variable limitdiffs
7989     pack $top.ldiff.b $top.ldiff.l -side left
7990     grid x $top.ldiff -sticky w
7991
7992     label $top.cdisp -text [mc "Colors: press to choose"]
7993     grid $top.cdisp - -sticky w -pady 10
7994     label $top.bg -padx 40 -relief sunk -background $bgcolor
7995     button $top.bgbut -text [mc "Background"] -font optionfont \
7996         -command [list choosecolor bgcolor 0 $top.bg background setbg]
7997     grid x $top.bgbut $top.bg -sticky w
7998     label $top.fg -padx 40 -relief sunk -background $fgcolor
7999     button $top.fgbut -text [mc "Foreground"] -font optionfont \
8000         -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
8001     grid x $top.fgbut $top.fg -sticky w
8002     label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
8003     button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
8004         -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
8005                       [list $ctext tag conf d0 -foreground]]
8006     grid x $top.diffoldbut $top.diffold -sticky w
8007     label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
8008     button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
8009         -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
8010                       [list $ctext tag conf d1 -foreground]]
8011     grid x $top.diffnewbut $top.diffnew -sticky w
8012     label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
8013     button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
8014         -command [list choosecolor diffcolors 2 $top.hunksep \
8015                       "diff hunk header" \
8016                       [list $ctext tag conf hunksep -foreground]]
8017     grid x $top.hunksepbut $top.hunksep -sticky w
8018     label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
8019     button $top.selbgbut -text [mc "Select bg"] -font optionfont \
8020         -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
8021     grid x $top.selbgbut $top.selbgsep -sticky w
8022
8023     label $top.cfont -text [mc "Fonts: press to choose"]
8024     grid $top.cfont - -sticky w -pady 10
8025     mkfontdisp mainfont $top [mc "Main font"]
8026     mkfontdisp textfont $top [mc "Diff display font"]
8027     mkfontdisp uifont $top [mc "User interface font"]
8028
8029     frame $top.buts
8030     button $top.buts.ok -text [mc "OK"] -command prefsok -default active
8031     button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
8032     grid $top.buts.ok $top.buts.can
8033     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8034     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8035     grid $top.buts - - -pady 10 -sticky ew
8036     bind $top <Visibility> "focus $top.buts.ok"
8037 }
8038
8039 proc choosecolor {v vi w x cmd} {
8040     global $v
8041
8042     set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
8043                -title [mc "Gitk: choose color for %s" $x]]
8044     if {$c eq {}} return
8045     $w conf -background $c
8046     lset $v $vi $c
8047     eval $cmd $c
8048 }
8049
8050 proc setselbg {c} {
8051     global bglist cflist
8052     foreach w $bglist {
8053         $w configure -selectbackground $c
8054     }
8055     $cflist tag configure highlight \
8056         -background [$cflist cget -selectbackground]
8057     allcanvs itemconf secsel -fill $c
8058 }
8059
8060 proc setbg {c} {
8061     global bglist
8062
8063     foreach w $bglist {
8064         $w conf -background $c
8065     }
8066 }
8067
8068 proc setfg {c} {
8069     global fglist canv
8070
8071     foreach w $fglist {
8072         $w conf -foreground $c
8073     }
8074     allcanvs itemconf text -fill $c
8075     $canv itemconf circle -outline $c
8076 }
8077
8078 proc prefscan {} {
8079     global oldprefs prefstop
8080
8081     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8082                    limitdiffs tabstop} {
8083         global $v
8084         set $v $oldprefs($v)
8085     }
8086     catch {destroy $prefstop}
8087     unset prefstop
8088     fontcan
8089 }
8090
8091 proc prefsok {} {
8092     global maxwidth maxgraphpct
8093     global oldprefs prefstop showneartags showlocalchanges
8094     global fontpref mainfont textfont uifont
8095     global limitdiffs treediffs
8096
8097     catch {destroy $prefstop}
8098     unset prefstop
8099     fontcan
8100     set fontchanged 0
8101     if {$mainfont ne $fontpref(mainfont)} {
8102         set mainfont $fontpref(mainfont)
8103         parsefont mainfont $mainfont
8104         eval font configure mainfont [fontflags mainfont]
8105         eval font configure mainfontbold [fontflags mainfont 1]
8106         setcoords
8107         set fontchanged 1
8108     }
8109     if {$textfont ne $fontpref(textfont)} {
8110         set textfont $fontpref(textfont)
8111         parsefont textfont $textfont
8112         eval font configure textfont [fontflags textfont]
8113         eval font configure textfontbold [fontflags textfont 1]
8114     }
8115     if {$uifont ne $fontpref(uifont)} {
8116         set uifont $fontpref(uifont)
8117         parsefont uifont $uifont
8118         eval font configure uifont [fontflags uifont]
8119     }
8120     settabs
8121     if {$showlocalchanges != $oldprefs(showlocalchanges)} {
8122         if {$showlocalchanges} {
8123             doshowlocalchanges
8124         } else {
8125             dohidelocalchanges
8126         }
8127     }
8128     if {$limitdiffs != $oldprefs(limitdiffs)} {
8129         # treediffs elements are limited by path
8130         catch {unset treediffs}
8131     }
8132     if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
8133         || $maxgraphpct != $oldprefs(maxgraphpct)} {
8134         redisplay
8135     } elseif {$showneartags != $oldprefs(showneartags) ||
8136           $limitdiffs != $oldprefs(limitdiffs)} {
8137         reselectline
8138     }
8139 }
8140
8141 proc formatdate {d} {
8142     global datetimeformat
8143     if {$d ne {}} {
8144         set d [clock format $d -format $datetimeformat]
8145     }
8146     return $d
8147 }
8148
8149 # This list of encoding names and aliases is distilled from
8150 # http://www.iana.org/assignments/character-sets.
8151 # Not all of them are supported by Tcl.
8152 set encoding_aliases {
8153     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
8154       ISO646-US US-ASCII us IBM367 cp367 csASCII }
8155     { ISO-10646-UTF-1 csISO10646UTF1 }
8156     { ISO_646.basic:1983 ref csISO646basic1983 }
8157     { INVARIANT csINVARIANT }
8158     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
8159     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
8160     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
8161     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
8162     { NATS-DANO iso-ir-9-1 csNATSDANO }
8163     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
8164     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
8165     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
8166     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
8167     { ISO-2022-KR csISO2022KR }
8168     { EUC-KR csEUCKR }
8169     { ISO-2022-JP csISO2022JP }
8170     { ISO-2022-JP-2 csISO2022JP2 }
8171     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
8172       csISO13JISC6220jp }
8173     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
8174     { IT iso-ir-15 ISO646-IT csISO15Italian }
8175     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
8176     { ES iso-ir-17 ISO646-ES csISO17Spanish }
8177     { greek7-old iso-ir-18 csISO18Greek7Old }
8178     { latin-greek iso-ir-19 csISO19LatinGreek }
8179     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
8180     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
8181     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
8182     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
8183     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
8184     { BS_viewdata iso-ir-47 csISO47BSViewdata }
8185     { INIS iso-ir-49 csISO49INIS }
8186     { INIS-8 iso-ir-50 csISO50INIS8 }
8187     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
8188     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
8189     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
8190     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
8191     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
8192     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
8193       csISO60Norwegian1 }
8194     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
8195     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
8196     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
8197     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
8198     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
8199     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
8200     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
8201     { greek7 iso-ir-88 csISO88Greek7 }
8202     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
8203     { iso-ir-90 csISO90 }
8204     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
8205     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
8206       csISO92JISC62991984b }
8207     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
8208     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
8209     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
8210       csISO95JIS62291984handadd }
8211     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
8212     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
8213     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
8214     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
8215       CP819 csISOLatin1 }
8216     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
8217     { T.61-7bit iso-ir-102 csISO102T617bit }
8218     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
8219     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
8220     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
8221     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
8222     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
8223     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
8224     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
8225     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
8226       arabic csISOLatinArabic }
8227     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
8228     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
8229     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
8230       greek greek8 csISOLatinGreek }
8231     { T.101-G2 iso-ir-128 csISO128T101G2 }
8232     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
8233       csISOLatinHebrew }
8234     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
8235     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
8236     { CSN_369103 iso-ir-139 csISO139CSN369103 }
8237     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
8238     { ISO_6937-2-add iso-ir-142 csISOTextComm }
8239     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
8240     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
8241       csISOLatinCyrillic }
8242     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
8243     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
8244     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
8245     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
8246     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
8247     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
8248     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
8249     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
8250     { ISO_10367-box iso-ir-155 csISO10367Box }
8251     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
8252     { latin-lap lap iso-ir-158 csISO158Lap }
8253     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
8254     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
8255     { us-dk csUSDK }
8256     { dk-us csDKUS }
8257     { JIS_X0201 X0201 csHalfWidthKatakana }
8258     { KSC5636 ISO646-KR csKSC5636 }
8259     { ISO-10646-UCS-2 csUnicode }
8260     { ISO-10646-UCS-4 csUCS4 }
8261     { DEC-MCS dec csDECMCS }
8262     { hp-roman8 roman8 r8 csHPRoman8 }
8263     { macintosh mac csMacintosh }
8264     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
8265       csIBM037 }
8266     { IBM038 EBCDIC-INT cp038 csIBM038 }
8267     { IBM273 CP273 csIBM273 }
8268     { IBM274 EBCDIC-BE CP274 csIBM274 }
8269     { IBM275 EBCDIC-BR cp275 csIBM275 }
8270     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
8271     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
8272     { IBM280 CP280 ebcdic-cp-it csIBM280 }
8273     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
8274     { IBM284 CP284 ebcdic-cp-es csIBM284 }
8275     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
8276     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
8277     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
8278     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
8279     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
8280     { IBM424 cp424 ebcdic-cp-he csIBM424 }
8281     { IBM437 cp437 437 csPC8CodePage437 }
8282     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
8283     { IBM775 cp775 csPC775Baltic }
8284     { IBM850 cp850 850 csPC850Multilingual }
8285     { IBM851 cp851 851 csIBM851 }
8286     { IBM852 cp852 852 csPCp852 }
8287     { IBM855 cp855 855 csIBM855 }
8288     { IBM857 cp857 857 csIBM857 }
8289     { IBM860 cp860 860 csIBM860 }
8290     { IBM861 cp861 861 cp-is csIBM861 }
8291     { IBM862 cp862 862 csPC862LatinHebrew }
8292     { IBM863 cp863 863 csIBM863 }
8293     { IBM864 cp864 csIBM864 }
8294     { IBM865 cp865 865 csIBM865 }
8295     { IBM866 cp866 866 csIBM866 }
8296     { IBM868 CP868 cp-ar csIBM868 }
8297     { IBM869 cp869 869 cp-gr csIBM869 }
8298     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
8299     { IBM871 CP871 ebcdic-cp-is csIBM871 }
8300     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
8301     { IBM891 cp891 csIBM891 }
8302     { IBM903 cp903 csIBM903 }
8303     { IBM904 cp904 904 csIBBM904 }
8304     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
8305     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
8306     { IBM1026 CP1026 csIBM1026 }
8307     { EBCDIC-AT-DE csIBMEBCDICATDE }
8308     { EBCDIC-AT-DE-A csEBCDICATDEA }
8309     { EBCDIC-CA-FR csEBCDICCAFR }
8310     { EBCDIC-DK-NO csEBCDICDKNO }
8311     { EBCDIC-DK-NO-A csEBCDICDKNOA }
8312     { EBCDIC-FI-SE csEBCDICFISE }
8313     { EBCDIC-FI-SE-A csEBCDICFISEA }
8314     { EBCDIC-FR csEBCDICFR }
8315     { EBCDIC-IT csEBCDICIT }
8316     { EBCDIC-PT csEBCDICPT }
8317     { EBCDIC-ES csEBCDICES }
8318     { EBCDIC-ES-A csEBCDICESA }
8319     { EBCDIC-ES-S csEBCDICESS }
8320     { EBCDIC-UK csEBCDICUK }
8321     { EBCDIC-US csEBCDICUS }
8322     { UNKNOWN-8BIT csUnknown8BiT }
8323     { MNEMONIC csMnemonic }
8324     { MNEM csMnem }
8325     { VISCII csVISCII }
8326     { VIQR csVIQR }
8327     { KOI8-R csKOI8R }
8328     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
8329     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
8330     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
8331     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
8332     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
8333     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
8334     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
8335     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
8336     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
8337     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
8338     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
8339     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
8340     { IBM1047 IBM-1047 }
8341     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
8342     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
8343     { UNICODE-1-1 csUnicode11 }
8344     { CESU-8 csCESU-8 }
8345     { BOCU-1 csBOCU-1 }
8346     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
8347     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
8348       l8 }
8349     { ISO-8859-15 ISO_8859-15 Latin-9 }
8350     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
8351     { GBK CP936 MS936 windows-936 }
8352     { JIS_Encoding csJISEncoding }
8353     { Shift_JIS MS_Kanji csShiftJIS }
8354     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
8355       EUC-JP }
8356     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
8357     { ISO-10646-UCS-Basic csUnicodeASCII }
8358     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
8359     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
8360     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
8361     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
8362     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
8363     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
8364     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
8365     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
8366     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
8367     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
8368     { Adobe-Standard-Encoding csAdobeStandardEncoding }
8369     { Ventura-US csVenturaUS }
8370     { Ventura-International csVenturaInternational }
8371     { PC8-Danish-Norwegian csPC8DanishNorwegian }
8372     { PC8-Turkish csPC8Turkish }
8373     { IBM-Symbols csIBMSymbols }
8374     { IBM-Thai csIBMThai }
8375     { HP-Legal csHPLegal }
8376     { HP-Pi-font csHPPiFont }
8377     { HP-Math8 csHPMath8 }
8378     { Adobe-Symbol-Encoding csHPPSMath }
8379     { HP-DeskTop csHPDesktop }
8380     { Ventura-Math csVenturaMath }
8381     { Microsoft-Publishing csMicrosoftPublishing }
8382     { Windows-31J csWindows31J }
8383     { GB2312 csGB2312 }
8384     { Big5 csBig5 }
8385 }
8386
8387 proc tcl_encoding {enc} {
8388     global encoding_aliases
8389     set names [encoding names]
8390     set lcnames [string tolower $names]
8391     set enc [string tolower $enc]
8392     set i [lsearch -exact $lcnames $enc]
8393     if {$i < 0} {
8394         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
8395         if {[regsub {^iso[-_]} $enc iso encx]} {
8396             set i [lsearch -exact $lcnames $encx]
8397         }
8398     }
8399     if {$i < 0} {
8400         foreach l $encoding_aliases {
8401             set ll [string tolower $l]
8402             if {[lsearch -exact $ll $enc] < 0} continue
8403             # look through the aliases for one that tcl knows about
8404             foreach e $ll {
8405                 set i [lsearch -exact $lcnames $e]
8406                 if {$i < 0} {
8407                     if {[regsub {^iso[-_]} $e iso ex]} {
8408                         set i [lsearch -exact $lcnames $ex]
8409                     }
8410                 }
8411                 if {$i >= 0} break
8412             }
8413             break
8414         }
8415     }
8416     if {$i >= 0} {
8417         return [lindex $names $i]
8418     }
8419     return {}
8420 }
8421
8422 # First check that Tcl/Tk is recent enough
8423 if {[catch {package require Tk 8.4} err]} {
8424     show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
8425                      Gitk requires at least Tcl/Tk 8.4."]
8426     exit 1
8427 }
8428
8429 # defaults...
8430 set datemode 0
8431 set wrcomcmd "git diff-tree --stdin -p --pretty"
8432
8433 set gitencoding {}
8434 catch {
8435     set gitencoding [exec git config --get i18n.commitencoding]
8436 }
8437 if {$gitencoding == ""} {
8438     set gitencoding "utf-8"
8439 }
8440 set tclencoding [tcl_encoding $gitencoding]
8441 if {$tclencoding == {}} {
8442     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
8443 }
8444
8445 set mainfont {Helvetica 9}
8446 set textfont {Courier 9}
8447 set uifont {Helvetica 9 bold}
8448 set tabstop 8
8449 set findmergefiles 0
8450 set maxgraphpct 50
8451 set maxwidth 16
8452 set revlistorder 0
8453 set fastdate 0
8454 set uparrowlen 5
8455 set downarrowlen 5
8456 set mingaplen 100
8457 set cmitmode "patch"
8458 set wrapcomment "none"
8459 set showneartags 1
8460 set maxrefs 20
8461 set maxlinelen 200
8462 set showlocalchanges 1
8463 set limitdiffs 1
8464 set datetimeformat "%Y-%m-%d %H:%M:%S"
8465
8466 set colors {green red blue magenta darkgrey brown orange}
8467 set bgcolor white
8468 set fgcolor black
8469 set diffcolors {red "#00a000" blue}
8470 set diffcontext 3
8471 set ignorespace 0
8472 set selectbgcolor gray85
8473
8474 ## For msgcat loading, first locate the installation location.
8475 if { [info exists ::env(GITK_MSGSDIR)] } {
8476     ## Msgsdir was manually set in the environment.
8477     set gitk_msgsdir $::env(GITK_MSGSDIR)
8478 } else {
8479     ## Let's guess the prefix from argv0.
8480     set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
8481     set gitk_libdir [file join $gitk_prefix share gitk lib]
8482     set gitk_msgsdir [file join $gitk_libdir msgs]
8483     unset gitk_prefix
8484 }
8485
8486 ## Internationalization (i18n) through msgcat and gettext. See
8487 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
8488 package require msgcat
8489 namespace import ::msgcat::mc
8490 ## And eventually load the actual message catalog
8491 ::msgcat::mcload $gitk_msgsdir
8492
8493 catch {source ~/.gitk}
8494
8495 font create optionfont -family sans-serif -size -12
8496
8497 parsefont mainfont $mainfont
8498 eval font create mainfont [fontflags mainfont]
8499 eval font create mainfontbold [fontflags mainfont 1]
8500
8501 parsefont textfont $textfont
8502 eval font create textfont [fontflags textfont]
8503 eval font create textfontbold [fontflags textfont 1]
8504
8505 parsefont uifont $uifont
8506 eval font create uifont [fontflags uifont]
8507
8508 setoptions
8509
8510 # check that we can find a .git directory somewhere...
8511 if {[catch {set gitdir [gitdir]}]} {
8512     show_error {} . [mc "Cannot find a git repository here."]
8513     exit 1
8514 }
8515 if {![file isdirectory $gitdir]} {
8516     show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
8517     exit 1
8518 }
8519
8520 set mergeonly 0
8521 set revtreeargs {}
8522 set cmdline_files {}
8523 set i 0
8524 foreach arg $argv {
8525     switch -- $arg {
8526         "" { }
8527         "-d" { set datemode 1 }
8528         "--merge" {
8529             set mergeonly 1
8530             lappend revtreeargs $arg
8531         }
8532         "--" {
8533             set cmdline_files [lrange $argv [expr {$i + 1}] end]
8534             break
8535         }
8536         default {
8537             lappend revtreeargs $arg
8538         }
8539     }
8540     incr i
8541 }
8542
8543 if {$i >= [llength $argv] && $revtreeargs ne {}} {
8544     # no -- on command line, but some arguments (other than -d)
8545     if {[catch {
8546         set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
8547         set cmdline_files [split $f "\n"]
8548         set n [llength $cmdline_files]
8549         set revtreeargs [lrange $revtreeargs 0 end-$n]
8550         # Unfortunately git rev-parse doesn't produce an error when
8551         # something is both a revision and a filename.  To be consistent
8552         # with git log and git rev-list, check revtreeargs for filenames.
8553         foreach arg $revtreeargs {
8554             if {[file exists $arg]} {
8555                 show_error {} . [mc "Ambiguous argument '%s': both revision\
8556                                  and filename" $arg]
8557                 exit 1
8558             }
8559         }
8560     } err]} {
8561         # unfortunately we get both stdout and stderr in $err,
8562         # so look for "fatal:".
8563         set i [string first "fatal:" $err]
8564         if {$i > 0} {
8565             set err [string range $err [expr {$i + 6}] end]
8566         }
8567         show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
8568         exit 1
8569     }
8570 }
8571
8572 if {$mergeonly} {
8573     # find the list of unmerged files
8574     set mlist {}
8575     set nr_unmerged 0
8576     if {[catch {
8577         set fd [open "| git ls-files -u" r]
8578     } err]} {
8579         show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
8580         exit 1
8581     }
8582     while {[gets $fd line] >= 0} {
8583         set i [string first "\t" $line]
8584         if {$i < 0} continue
8585         set fname [string range $line [expr {$i+1}] end]
8586         if {[lsearch -exact $mlist $fname] >= 0} continue
8587         incr nr_unmerged
8588         if {$cmdline_files eq {} || [path_filter $cmdline_files $fname]} {
8589             lappend mlist $fname
8590         }
8591     }
8592     catch {close $fd}
8593     if {$mlist eq {}} {
8594         if {$nr_unmerged == 0} {
8595             show_error {} . [mc "No files selected: --merge specified but\
8596                              no files are unmerged."]
8597         } else {
8598             show_error {} . [mc "No files selected: --merge specified but\
8599                              no unmerged files are within file limit."]
8600         }
8601         exit 1
8602     }
8603     set cmdline_files $mlist
8604 }
8605
8606 set nullid "0000000000000000000000000000000000000000"
8607 set nullid2 "0000000000000000000000000000000000000001"
8608
8609 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
8610
8611 set runq {}
8612 set history {}
8613 set historyindex 0
8614 set fh_serial 0
8615 set nhl_names {}
8616 set highlight_paths {}
8617 set findpattern {}
8618 set searchdirn -forwards
8619 set boldrows {}
8620 set boldnamerows {}
8621 set diffelide {0 0}
8622 set markingmatches 0
8623 set linkentercount 0
8624 set need_redisplay 0
8625 set nrows_drawn 0
8626 set firsttabstop 0
8627
8628 set nextviewnum 1
8629 set curview 0
8630 set selectedview 0
8631 set selectedhlview [mc "None"]
8632 set highlight_related [mc "None"]
8633 set highlight_files {}
8634 set viewfiles(0) {}
8635 set viewperm(0) 0
8636 set viewargs(0) {}
8637
8638 set cmdlineok 0
8639 set stopped 0
8640 set stuffsaved 0
8641 set patchnum 0
8642 set localirow -1
8643 set localfrow -1
8644 set lserial 0
8645 setcoords
8646 makewindow
8647 # wait for the window to become visible
8648 tkwait visibility .
8649 wm title . "[file tail $argv0]: [file tail [pwd]]"
8650 readrefs
8651
8652 if {$cmdline_files ne {} || $revtreeargs ne {}} {
8653     # create a view for the files/dirs specified on the command line
8654     set curview 1
8655     set selectedview 1
8656     set nextviewnum 2
8657     set viewname(1) [mc "Command line"]
8658     set viewfiles(1) $cmdline_files
8659     set viewargs(1) $revtreeargs
8660     set viewperm(1) 0
8661     addviewmenu 1
8662     .bar.view entryconf [mc "Edit view..."] -state normal
8663     .bar.view entryconf [mc "Delete view"] -state normal
8664 }
8665
8666 if {[info exists permviews]} {
8667     foreach v $permviews {
8668         set n $nextviewnum
8669         incr nextviewnum
8670         set viewname($n) [lindex $v 0]
8671         set viewfiles($n) [lindex $v 1]
8672         set viewargs($n) [lindex $v 2]
8673         set viewperm($n) 1
8674         addviewmenu $n
8675     }
8676 }
8677 getcommits