gitk

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