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