gitk-git/gitk

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