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