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