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