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} {
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 diffopts 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 env(GIT_DIFF_OPTS) $diffopts
5130     set cmd [concat | git diff-tree --no-commit-id --cc $id]
5131     if {[catch {set mdf [open $cmd r]} err]} {
5132         error_popup "Error getting merge diffs: $err"
5133         return
5134     }
5135     fconfigure $mdf -blocking 0
5136     set mdifffd($id) $mdf
5137     set np [llength [lindex $parentlist $l]]
5138     settabs $np
5139     filerun $mdf [list getmergediffline $mdf $id $np]
5140 }
5141
5142 proc getmergediffline {mdf id np} {
5143     global diffmergeid ctext cflist mergemax
5144     global difffilestart mdifffd
5145
5146     $ctext conf -state normal
5147     set nr 0
5148     while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
5149         if {![info exists diffmergeid] || $id != $diffmergeid
5150             || $mdf != $mdifffd($id)} {
5151             close $mdf
5152             return 0
5153         }
5154         if {[regexp {^diff --cc (.*)} $line match fname]} {
5155             # start of a new file
5156             $ctext insert end "\n"
5157             set here [$ctext index "end - 1c"]
5158             lappend difffilestart $here
5159             add_flist [list $fname]
5160             set l [expr {(78 - [string length $fname]) / 2}]
5161             set pad [string range "----------------------------------------" 1 $l]
5162             $ctext insert end "$pad $fname $pad\n" filesep
5163         } elseif {[regexp {^@@} $line]} {
5164             $ctext insert end "$line\n" hunksep
5165         } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
5166             # do nothing
5167         } else {
5168             # parse the prefix - one ' ', '-' or '+' for each parent
5169             set spaces {}
5170             set minuses {}
5171             set pluses {}
5172             set isbad 0
5173             for {set j 0} {$j < $np} {incr j} {
5174                 set c [string range $line $j $j]
5175                 if {$c == " "} {
5176                     lappend spaces $j
5177                 } elseif {$c == "-"} {
5178                     lappend minuses $j
5179                 } elseif {$c == "+"} {
5180                     lappend pluses $j
5181                 } else {
5182                     set isbad 1
5183                     break
5184                 }
5185             }
5186             set tags {}
5187             set num {}
5188             if {!$isbad && $minuses ne {} && $pluses eq {}} {
5189                 # line doesn't appear in result, parents in $minuses have the line
5190                 set num [lindex $minuses 0]
5191             } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
5192                 # line appears in result, parents in $pluses don't have the line
5193                 lappend tags mresult
5194                 set num [lindex $spaces 0]
5195             }
5196             if {$num ne {}} {
5197                 if {$num >= $mergemax} {
5198                     set num "max"
5199                 }
5200                 lappend tags m$num
5201             }
5202             $ctext insert end "$line\n" $tags
5203         }
5204     }
5205     $ctext conf -state disabled
5206     if {[eof $mdf]} {
5207         close $mdf
5208         return 0
5209     }
5210     return [expr {$nr >= 1000? 2: 1}]
5211 }
5212
5213 proc startdiff {ids} {
5214     global treediffs diffids treepending diffmergeid nullid nullid2
5215
5216     settabs 1
5217     set diffids $ids
5218     catch {unset diffmergeid}
5219     if {![info exists treediffs($ids)] ||
5220         [lsearch -exact $ids $nullid] >= 0 ||
5221         [lsearch -exact $ids $nullid2] >= 0} {
5222         if {![info exists treepending]} {
5223             gettreediffs $ids
5224         }
5225     } else {
5226         addtocflist $ids
5227     }
5228 }
5229
5230 proc addtocflist {ids} {
5231     global treediffs cflist
5232     add_flist $treediffs($ids)
5233     getblobdiffs $ids
5234 }
5235
5236 proc diffcmd {ids flags} {
5237     global nullid nullid2
5238
5239     set i [lsearch -exact $ids $nullid]
5240     set j [lsearch -exact $ids $nullid2]
5241     if {$i >= 0} {
5242         if {[llength $ids] > 1 && $j < 0} {
5243             # comparing working directory with some specific revision
5244             set cmd [concat | git diff-index $flags]
5245             if {$i == 0} {
5246                 lappend cmd -R [lindex $ids 1]
5247             } else {
5248                 lappend cmd [lindex $ids 0]
5249             }
5250         } else {
5251             # comparing working directory with index
5252             set cmd [concat | git diff-files $flags]
5253             if {$j == 1} {
5254                 lappend cmd -R
5255             }
5256         }
5257     } elseif {$j >= 0} {
5258         set cmd [concat | git diff-index --cached $flags]
5259         if {[llength $ids] > 1} {
5260             # comparing index with specific revision
5261             if {$i == 0} {
5262                 lappend cmd -R [lindex $ids 1]
5263             } else {
5264                 lappend cmd [lindex $ids 0]
5265             }
5266         } else {
5267             # comparing index with HEAD
5268             lappend cmd HEAD
5269         }
5270     } else {
5271         set cmd [concat | git diff-tree -r $flags $ids]
5272     }
5273     return $cmd
5274 }
5275
5276 proc gettreediffs {ids} {
5277     global treediff treepending
5278
5279     set treepending $ids
5280     set treediff {}
5281     if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5282     fconfigure $gdtf -blocking 0
5283     filerun $gdtf [list gettreediffline $gdtf $ids]
5284 }
5285
5286 proc gettreediffline {gdtf ids} {
5287     global treediff treediffs treepending diffids diffmergeid
5288     global cmitmode
5289
5290     set nr 0
5291     while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
5292         set i [string first "\t" $line]
5293         if {$i >= 0} {
5294             set file [string range $line [expr {$i+1}] end]
5295             if {[string index $file 0] eq "\""} {
5296                 set file [lindex $file 0]
5297             }
5298             lappend treediff $file
5299         }
5300     }
5301     if {![eof $gdtf]} {
5302         return [expr {$nr >= 1000? 2: 1}]
5303     }
5304     close $gdtf
5305     set treediffs($ids) $treediff
5306     unset treepending
5307     if {$cmitmode eq "tree"} {
5308         gettree $diffids
5309     } elseif {$ids != $diffids} {
5310         if {![info exists diffmergeid]} {
5311             gettreediffs $diffids
5312         }
5313     } else {
5314         addtocflist $ids
5315     }
5316     return 0
5317 }
5318
5319 # empty string or positive integer
5320 proc diffcontextvalidate {v} {
5321     return [regexp {^(|[1-9][0-9]*)$} $v]
5322 }
5323
5324 proc diffcontextchange {n1 n2 op} {
5325     global diffcontextstring diffcontext
5326
5327     if {[string is integer -strict $diffcontextstring]} {
5328         if {$diffcontextstring > 0} {
5329             set diffcontext $diffcontextstring
5330             reselectline
5331         }
5332     }
5333 }
5334
5335 proc getblobdiffs {ids} {
5336     global diffopts blobdifffd diffids env
5337     global diffinhdr treediffs
5338     global diffcontext
5339
5340     set env(GIT_DIFF_OPTS) $diffopts
5341     if {[catch {set bdf [open [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"] r]} err]} {
5342         puts "error getting diffs: $err"
5343         return
5344     }
5345     set diffinhdr 0
5346     fconfigure $bdf -blocking 0
5347     set blobdifffd($ids) $bdf
5348     filerun $bdf [list getblobdiffline $bdf $diffids]
5349 }
5350
5351 proc setinlist {var i val} {
5352     global $var
5353
5354     while {[llength [set $var]] < $i} {
5355         lappend $var {}
5356     }
5357     if {[llength [set $var]] == $i} {
5358         lappend $var $val
5359     } else {
5360         lset $var $i $val
5361     }
5362 }
5363
5364 proc makediffhdr {fname ids} {
5365     global ctext curdiffstart treediffs
5366
5367     set i [lsearch -exact $treediffs($ids) $fname]
5368     if {$i >= 0} {
5369         setinlist difffilestart $i $curdiffstart
5370     }
5371     set l [expr {(78 - [string length $fname]) / 2}]
5372     set pad [string range "----------------------------------------" 1 $l]
5373     $ctext insert $curdiffstart "$pad $fname $pad" filesep
5374 }
5375
5376 proc getblobdiffline {bdf ids} {
5377     global diffids blobdifffd ctext curdiffstart
5378     global diffnexthead diffnextnote difffilestart
5379     global diffinhdr treediffs
5380
5381     set nr 0
5382     $ctext conf -state normal
5383     while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
5384         if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
5385             close $bdf
5386             return 0
5387         }
5388         if {![string compare -length 11 "diff --git " $line]} {
5389             # trim off "diff --git "
5390             set line [string range $line 11 end]
5391             set diffinhdr 1
5392             # start of a new file
5393             $ctext insert end "\n"
5394             set curdiffstart [$ctext index "end - 1c"]
5395             $ctext insert end "\n" filesep
5396             # If the name hasn't changed the length will be odd,
5397             # the middle char will be a space, and the two bits either
5398             # side will be a/name and b/name, or "a/name" and "b/name".
5399             # If the name has changed we'll get "rename from" and
5400             # "rename to" or "copy from" and "copy to" lines following this,
5401             # and we'll use them to get the filenames.
5402             # This complexity is necessary because spaces in the filename(s)
5403             # don't get escaped.
5404             set l [string length $line]
5405             set i [expr {$l / 2}]
5406             if {!(($l & 1) && [string index $line $i] eq " " &&
5407                   [string range $line 2 [expr {$i - 1}]] eq \
5408                       [string range $line [expr {$i + 3}] end])} {
5409                 continue
5410             }
5411             # unescape if quoted and chop off the a/ from the front
5412             if {[string index $line 0] eq "\""} {
5413                 set fname [string range [lindex $line 0] 2 end]
5414             } else {
5415                 set fname [string range $line 2 [expr {$i - 1}]]
5416             }
5417             makediffhdr $fname $ids
5418
5419         } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
5420                        $line match f1l f1c f2l f2c rest]} {
5421             $ctext insert end "$line\n" hunksep
5422             set diffinhdr 0
5423
5424         } elseif {$diffinhdr} {
5425             if {![string compare -length 12 "rename from " $line] ||
5426                 ![string compare -length 10 "copy from " $line]} {
5427                 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
5428                 if {[string index $fname 0] eq "\""} {
5429                     set fname [lindex $fname 0]
5430                 }
5431                 set i [lsearch -exact $treediffs($ids) $fname]
5432                 if {$i >= 0} {
5433                     setinlist difffilestart $i $curdiffstart
5434                 }
5435             } elseif {![string compare -length 10 $line "rename to "] ||
5436                       ![string compare -length 8 $line "copy to "]} {
5437                 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
5438                 if {[string index $fname 0] eq "\""} {
5439                     set fname [lindex $fname 0]
5440                 }
5441                 makediffhdr $fname $ids
5442             } elseif {[string compare -length 3 $line "---"] == 0} {
5443                 # do nothing
5444                 continue
5445             } elseif {[string compare -length 3 $line "+++"] == 0} {
5446                 set diffinhdr 0
5447                 continue
5448             }
5449             $ctext insert end "$line\n" filesep
5450
5451         } else {
5452             set x [string range $line 0 0]
5453             if {$x == "-" || $x == "+"} {
5454                 set tag [expr {$x == "+"}]
5455                 $ctext insert end "$line\n" d$tag
5456             } elseif {$x == " "} {
5457                 $ctext insert end "$line\n"
5458             } else {
5459                 # "\ No newline at end of file",
5460                 # or something else we don't recognize
5461                 $ctext insert end "$line\n" hunksep
5462             }
5463         }
5464     }
5465     $ctext conf -state disabled
5466     if {[eof $bdf]} {
5467         close $bdf
5468         return 0
5469     }
5470     return [expr {$nr >= 1000? 2: 1}]
5471 }
5472
5473 proc changediffdisp {} {
5474     global ctext diffelide
5475
5476     $ctext tag conf d0 -elide [lindex $diffelide 0]
5477     $ctext tag conf d1 -elide [lindex $diffelide 1]
5478 }
5479
5480 proc prevfile {} {
5481     global difffilestart ctext
5482     set prev [lindex $difffilestart 0]
5483     set here [$ctext index @0,0]
5484     foreach loc $difffilestart {
5485         if {[$ctext compare $loc >= $here]} {
5486             $ctext yview $prev
5487             return
5488         }
5489         set prev $loc
5490     }
5491     $ctext yview $prev
5492 }
5493
5494 proc nextfile {} {
5495     global difffilestart ctext
5496     set here [$ctext index @0,0]
5497     foreach loc $difffilestart {
5498         if {[$ctext compare $loc > $here]} {
5499             $ctext yview $loc
5500             return
5501         }
5502     }
5503 }
5504
5505 proc clear_ctext {{first 1.0}} {
5506     global ctext smarktop smarkbot
5507     global pendinglinks
5508
5509     set l [lindex [split $first .] 0]
5510     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5511         set smarktop $l
5512     }
5513     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5514         set smarkbot $l
5515     }
5516     $ctext delete $first end
5517     if {$first eq "1.0"} {
5518         catch {unset pendinglinks}
5519     }
5520 }
5521
5522 proc settabs {{firstab {}}} {
5523     global firsttabstop tabstop ctext have_tk85
5524
5525     if {$firstab ne {} && $have_tk85} {
5526         set firsttabstop $firstab
5527     }
5528     set w [font measure textfont "0"]
5529     if {$firsttabstop != 0} {
5530         $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
5531                                [expr {($firsttabstop + 2 * $tabstop) * $w}]]
5532     } elseif {$have_tk85 || $tabstop != 8} {
5533         $ctext conf -tabs [expr {$tabstop * $w}]
5534     } else {
5535         $ctext conf -tabs {}
5536     }
5537 }
5538
5539 proc incrsearch {name ix op} {
5540     global ctext searchstring searchdirn
5541
5542     $ctext tag remove found 1.0 end
5543     if {[catch {$ctext index anchor}]} {
5544         # no anchor set, use start of selection, or of visible area
5545         set sel [$ctext tag ranges sel]
5546         if {$sel ne {}} {
5547             $ctext mark set anchor [lindex $sel 0]
5548         } elseif {$searchdirn eq "-forwards"} {
5549             $ctext mark set anchor @0,0
5550         } else {
5551             $ctext mark set anchor @0,[winfo height $ctext]
5552         }
5553     }
5554     if {$searchstring ne {}} {
5555         set here [$ctext search $searchdirn -- $searchstring anchor]
5556         if {$here ne {}} {
5557             $ctext see $here
5558         }
5559         searchmarkvisible 1
5560     }
5561 }
5562
5563 proc dosearch {} {
5564     global sstring ctext searchstring searchdirn
5565
5566     focus $sstring
5567     $sstring icursor end
5568     set searchdirn -forwards
5569     if {$searchstring ne {}} {
5570         set sel [$ctext tag ranges sel]
5571         if {$sel ne {}} {
5572             set start "[lindex $sel 0] + 1c"
5573         } elseif {[catch {set start [$ctext index anchor]}]} {
5574             set start "@0,0"
5575         }
5576         set match [$ctext search -count mlen -- $searchstring $start]
5577         $ctext tag remove sel 1.0 end
5578         if {$match eq {}} {
5579             bell
5580             return
5581         }
5582         $ctext see $match
5583         set mend "$match + $mlen c"
5584         $ctext tag add sel $match $mend
5585         $ctext mark unset anchor
5586     }
5587 }
5588
5589 proc dosearchback {} {
5590     global sstring ctext searchstring searchdirn
5591
5592     focus $sstring
5593     $sstring icursor end
5594     set searchdirn -backwards
5595     if {$searchstring ne {}} {
5596         set sel [$ctext tag ranges sel]
5597         if {$sel ne {}} {
5598             set start [lindex $sel 0]
5599         } elseif {[catch {set start [$ctext index anchor]}]} {
5600             set start @0,[winfo height $ctext]
5601         }
5602         set match [$ctext search -backwards -count ml -- $searchstring $start]
5603         $ctext tag remove sel 1.0 end
5604         if {$match eq {}} {
5605             bell
5606             return
5607         }
5608         $ctext see $match
5609         set mend "$match + $ml c"
5610         $ctext tag add sel $match $mend
5611         $ctext mark unset anchor
5612     }
5613 }
5614
5615 proc searchmark {first last} {
5616     global ctext searchstring
5617
5618     set mend $first.0
5619     while {1} {
5620         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5621         if {$match eq {}} break
5622         set mend "$match + $mlen c"
5623         $ctext tag add found $match $mend
5624     }
5625 }
5626
5627 proc searchmarkvisible {doall} {
5628     global ctext smarktop smarkbot
5629
5630     set topline [lindex [split [$ctext index @0,0] .] 0]
5631     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5632     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5633         # no overlap with previous
5634         searchmark $topline $botline
5635         set smarktop $topline
5636         set smarkbot $botline
5637     } else {
5638         if {$topline < $smarktop} {
5639             searchmark $topline [expr {$smarktop-1}]
5640             set smarktop $topline
5641         }
5642         if {$botline > $smarkbot} {
5643             searchmark [expr {$smarkbot+1}] $botline
5644             set smarkbot $botline
5645         }
5646     }
5647 }
5648
5649 proc scrolltext {f0 f1} {
5650     global searchstring
5651
5652     .bleft.sb set $f0 $f1
5653     if {$searchstring ne {}} {
5654         searchmarkvisible 0
5655     }
5656 }
5657
5658 proc setcoords {} {
5659     global linespc charspc canvx0 canvy0
5660     global xspc1 xspc2 lthickness
5661
5662     set linespc [font metrics mainfont -linespace]
5663     set charspc [font measure mainfont "m"]
5664     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5665     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5666     set lthickness [expr {int($linespc / 9) + 1}]
5667     set xspc1(0) $linespc
5668     set xspc2 $linespc
5669 }
5670
5671 proc redisplay {} {
5672     global canv
5673     global selectedline
5674
5675     set ymax [lindex [$canv cget -scrollregion] 3]
5676     if {$ymax eq {} || $ymax == 0} return
5677     set span [$canv yview]
5678     clear_display
5679     setcanvscroll
5680     allcanvs yview moveto [lindex $span 0]
5681     drawvisible
5682     if {[info exists selectedline]} {
5683         selectline $selectedline 0
5684         allcanvs yview moveto [lindex $span 0]
5685     }
5686 }
5687
5688 proc parsefont {f n} {
5689     global fontattr
5690
5691     set fontattr($f,family) [lindex $n 0]
5692     set s [lindex $n 1]
5693     if {$s eq {} || $s == 0} {
5694         set s 10
5695     } elseif {$s < 0} {
5696         set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
5697     }
5698     set fontattr($f,size) $s
5699     set fontattr($f,weight) normal
5700     set fontattr($f,slant) roman
5701     foreach style [lrange $n 2 end] {
5702         switch -- $style {
5703             "normal" -
5704             "bold"   {set fontattr($f,weight) $style}
5705             "roman" -
5706             "italic" {set fontattr($f,slant) $style}
5707         }
5708     }
5709 }
5710
5711 proc fontflags {f {isbold 0}} {
5712     global fontattr
5713
5714     return [list -family $fontattr($f,family) -size $fontattr($f,size) \
5715                 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
5716                 -slant $fontattr($f,slant)]
5717 }
5718
5719 proc fontname {f} {
5720     global fontattr
5721
5722     set n [list $fontattr($f,family) $fontattr($f,size)]
5723     if {$fontattr($f,weight) eq "bold"} {
5724         lappend n "bold"
5725     }
5726     if {$fontattr($f,slant) eq "italic"} {
5727         lappend n "italic"
5728     }
5729     return $n
5730 }
5731
5732 proc incrfont {inc} {
5733     global mainfont textfont ctext canv phase cflist showrefstop
5734     global stopped entries fontattr
5735
5736     unmarkmatches
5737     set s $fontattr(mainfont,size)
5738     incr s $inc
5739     if {$s < 1} {
5740         set s 1
5741     }
5742     set fontattr(mainfont,size) $s
5743     font config mainfont -size $s
5744     font config mainfontbold -size $s
5745     set mainfont [fontname mainfont]
5746     set s $fontattr(textfont,size)
5747     incr s $inc
5748     if {$s < 1} {
5749         set s 1
5750     }
5751     set fontattr(textfont,size) $s
5752     font config textfont -size $s
5753     font config textfontbold -size $s
5754     set textfont [fontname textfont]
5755     setcoords
5756     settabs
5757     redisplay
5758 }
5759
5760 proc clearsha1 {} {
5761     global sha1entry sha1string
5762     if {[string length $sha1string] == 40} {
5763         $sha1entry delete 0 end
5764     }
5765 }
5766
5767 proc sha1change {n1 n2 op} {
5768     global sha1string currentid sha1but
5769     if {$sha1string == {}
5770         || ([info exists currentid] && $sha1string == $currentid)} {
5771         set state disabled
5772     } else {
5773         set state normal
5774     }
5775     if {[$sha1but cget -state] == $state} return
5776     if {$state == "normal"} {
5777         $sha1but conf -state normal -relief raised -text "Goto: "
5778     } else {
5779         $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
5780     }
5781 }
5782
5783 proc gotocommit {} {
5784     global sha1string currentid commitrow tagids headids
5785     global displayorder numcommits curview
5786
5787     if {$sha1string == {}
5788         || ([info exists currentid] && $sha1string == $currentid)} return
5789     if {[info exists tagids($sha1string)]} {
5790         set id $tagids($sha1string)
5791     } elseif {[info exists headids($sha1string)]} {
5792         set id $headids($sha1string)
5793     } else {
5794         set id [string tolower $sha1string]
5795         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5796             set matches {}
5797             foreach i $displayorder {
5798                 if {[string match $id* $i]} {
5799                     lappend matches $i
5800                 }
5801             }
5802             if {$matches ne {}} {
5803                 if {[llength $matches] > 1} {
5804                     error_popup "Short SHA1 id $id is ambiguous"
5805                     return
5806                 }
5807                 set id [lindex $matches 0]
5808             }
5809         }
5810     }
5811     if {[info exists commitrow($curview,$id)]} {
5812         selectline $commitrow($curview,$id) 1
5813         return
5814     }
5815     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5816         set type "SHA1 id"
5817     } else {
5818         set type "Tag/Head"
5819     }
5820     error_popup "$type $sha1string is not known"
5821 }
5822
5823 proc lineenter {x y id} {
5824     global hoverx hovery hoverid hovertimer
5825     global commitinfo canv
5826
5827     if {![info exists commitinfo($id)] && ![getcommit $id]} return
5828     set hoverx $x
5829     set hovery $y
5830     set hoverid $id
5831     if {[info exists hovertimer]} {
5832         after cancel $hovertimer
5833     }
5834     set hovertimer [after 500 linehover]
5835     $canv delete hover
5836 }
5837
5838 proc linemotion {x y id} {
5839     global hoverx hovery hoverid hovertimer
5840
5841     if {[info exists hoverid] && $id == $hoverid} {
5842         set hoverx $x
5843         set hovery $y
5844         if {[info exists hovertimer]} {
5845             after cancel $hovertimer
5846         }
5847         set hovertimer [after 500 linehover]
5848     }
5849 }
5850
5851 proc lineleave {id} {
5852     global hoverid hovertimer canv
5853
5854     if {[info exists hoverid] && $id == $hoverid} {
5855         $canv delete hover
5856         if {[info exists hovertimer]} {
5857             after cancel $hovertimer
5858             unset hovertimer
5859         }
5860         unset hoverid
5861     }
5862 }
5863
5864 proc linehover {} {
5865     global hoverx hovery hoverid hovertimer
5866     global canv linespc lthickness
5867     global commitinfo
5868
5869     set text [lindex $commitinfo($hoverid) 0]
5870     set ymax [lindex [$canv cget -scrollregion] 3]
5871     if {$ymax == {}} return
5872     set yfrac [lindex [$canv yview] 0]
5873     set x [expr {$hoverx + 2 * $linespc}]
5874     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5875     set x0 [expr {$x - 2 * $lthickness}]
5876     set y0 [expr {$y - 2 * $lthickness}]
5877     set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
5878     set y1 [expr {$y + $linespc + 2 * $lthickness}]
5879     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5880                -fill \#ffff80 -outline black -width 1 -tags hover]
5881     $canv raise $t
5882     set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5883                -font mainfont]
5884     $canv raise $t
5885 }
5886
5887 proc clickisonarrow {id y} {
5888     global lthickness
5889
5890     set ranges [rowranges $id]
5891     set thresh [expr {2 * $lthickness + 6}]
5892     set n [expr {[llength $ranges] - 1}]
5893     for {set i 1} {$i < $n} {incr i} {
5894         set row [lindex $ranges $i]
5895         if {abs([yc $row] - $y) < $thresh} {
5896             return $i
5897         }
5898     }
5899     return {}
5900 }
5901
5902 proc arrowjump {id n y} {
5903     global canv
5904
5905     # 1 <-> 2, 3 <-> 4, etc...
5906     set n [expr {(($n - 1) ^ 1) + 1}]
5907     set row [lindex [rowranges $id] $n]
5908     set yt [yc $row]
5909     set ymax [lindex [$canv cget -scrollregion] 3]
5910     if {$ymax eq {} || $ymax <= 0} return
5911     set view [$canv yview]
5912     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5913     set yfrac [expr {$yt / $ymax - $yspan / 2}]
5914     if {$yfrac < 0} {
5915         set yfrac 0
5916     }
5917     allcanvs yview moveto $yfrac
5918 }
5919
5920 proc lineclick {x y id isnew} {
5921     global ctext commitinfo children canv thickerline curview commitrow
5922
5923     if {![info exists commitinfo($id)] && ![getcommit $id]} return
5924     unmarkmatches
5925     unselectline
5926     normalline
5927     $canv delete hover
5928     # draw this line thicker than normal
5929     set thickerline $id
5930     drawlines $id
5931     if {$isnew} {
5932         set ymax [lindex [$canv cget -scrollregion] 3]
5933         if {$ymax eq {}} return
5934         set yfrac [lindex [$canv yview] 0]
5935         set y [expr {$y + $yfrac * $ymax}]
5936     }
5937     set dirn [clickisonarrow $id $y]
5938     if {$dirn ne {}} {
5939         arrowjump $id $dirn $y
5940         return
5941     }
5942
5943     if {$isnew} {
5944         addtohistory [list lineclick $x $y $id 0]
5945     }
5946     # fill the details pane with info about this line
5947     $ctext conf -state normal
5948     clear_ctext
5949     settabs 0
5950     $ctext insert end "Parent:\t"
5951     $ctext insert end $id link0
5952     setlink $id link0
5953     set info $commitinfo($id)
5954     $ctext insert end "\n\t[lindex $info 0]\n"
5955     $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
5956     set date [formatdate [lindex $info 2]]
5957     $ctext insert end "\tDate:\t$date\n"
5958     set kids $children($curview,$id)
5959     if {$kids ne {}} {
5960         $ctext insert end "\nChildren:"
5961         set i 0
5962         foreach child $kids {
5963             incr i
5964             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5965             set info $commitinfo($child)
5966             $ctext insert end "\n\t"
5967             $ctext insert end $child link$i
5968             setlink $child link$i
5969             $ctext insert end "\n\t[lindex $info 0]"
5970             $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
5971             set date [formatdate [lindex $info 2]]
5972             $ctext insert end "\n\tDate:\t$date\n"
5973         }
5974     }
5975     $ctext conf -state disabled
5976     init_flist {}
5977 }
5978
5979 proc normalline {} {
5980     global thickerline
5981     if {[info exists thickerline]} {
5982         set id $thickerline
5983         unset thickerline
5984         drawlines $id
5985     }
5986 }
5987
5988 proc selbyid {id} {
5989     global commitrow curview
5990     if {[info exists commitrow($curview,$id)]} {
5991         selectline $commitrow($curview,$id) 1
5992     }
5993 }
5994
5995 proc mstime {} {
5996     global startmstime
5997     if {![info exists startmstime]} {
5998         set startmstime [clock clicks -milliseconds]
5999     }
6000     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
6001 }
6002
6003 proc rowmenu {x y id} {
6004     global rowctxmenu commitrow selectedline rowmenuid curview
6005     global nullid nullid2 fakerowmenu mainhead
6006
6007     stopfinding
6008     set rowmenuid $id
6009     if {![info exists selectedline]
6010         || $commitrow($curview,$id) eq $selectedline} {
6011         set state disabled
6012     } else {
6013         set state normal
6014     }
6015     if {$id ne $nullid && $id ne $nullid2} {
6016         set menu $rowctxmenu
6017         $menu entryconfigure 7 -label "Reset $mainhead branch to here"
6018     } else {
6019         set menu $fakerowmenu
6020     }
6021     $menu entryconfigure "Diff this*" -state $state
6022     $menu entryconfigure "Diff selected*" -state $state
6023     $menu entryconfigure "Make patch" -state $state
6024     tk_popup $menu $x $y
6025 }
6026
6027 proc diffvssel {dirn} {
6028     global rowmenuid selectedline displayorder
6029
6030     if {![info exists selectedline]} return
6031     if {$dirn} {
6032         set oldid [lindex $displayorder $selectedline]
6033         set newid $rowmenuid
6034     } else {
6035         set oldid $rowmenuid
6036         set newid [lindex $displayorder $selectedline]
6037     }
6038     addtohistory [list doseldiff $oldid $newid]
6039     doseldiff $oldid $newid
6040 }
6041
6042 proc doseldiff {oldid newid} {
6043     global ctext
6044     global commitinfo
6045
6046     $ctext conf -state normal
6047     clear_ctext
6048     init_flist "Top"
6049     $ctext insert end "From "
6050     $ctext insert end $oldid link0
6051     setlink $oldid link0
6052     $ctext insert end "\n     "
6053     $ctext insert end [lindex $commitinfo($oldid) 0]
6054     $ctext insert end "\n\nTo   "
6055     $ctext insert end $newid link1
6056     setlink $newid link1
6057     $ctext insert end "\n     "
6058     $ctext insert end [lindex $commitinfo($newid) 0]
6059     $ctext insert end "\n"
6060     $ctext conf -state disabled
6061     $ctext tag remove found 1.0 end
6062     startdiff [list $oldid $newid]
6063 }
6064
6065 proc mkpatch {} {
6066     global rowmenuid currentid commitinfo patchtop patchnum
6067
6068     if {![info exists currentid]} return
6069     set oldid $currentid
6070     set oldhead [lindex $commitinfo($oldid) 0]
6071     set newid $rowmenuid
6072     set newhead [lindex $commitinfo($newid) 0]
6073     set top .patch
6074     set patchtop $top
6075     catch {destroy $top}
6076     toplevel $top
6077     label $top.title -text "Generate patch"
6078     grid $top.title - -pady 10
6079     label $top.from -text "From:"
6080     entry $top.fromsha1 -width 40 -relief flat
6081     $top.fromsha1 insert 0 $oldid
6082     $top.fromsha1 conf -state readonly
6083     grid $top.from $top.fromsha1 -sticky w
6084     entry $top.fromhead -width 60 -relief flat
6085     $top.fromhead insert 0 $oldhead
6086     $top.fromhead conf -state readonly
6087     grid x $top.fromhead -sticky w
6088     label $top.to -text "To:"
6089     entry $top.tosha1 -width 40 -relief flat
6090     $top.tosha1 insert 0 $newid
6091     $top.tosha1 conf -state readonly
6092     grid $top.to $top.tosha1 -sticky w
6093     entry $top.tohead -width 60 -relief flat
6094     $top.tohead insert 0 $newhead
6095     $top.tohead conf -state readonly
6096     grid x $top.tohead -sticky w
6097     button $top.rev -text "Reverse" -command mkpatchrev -padx 5
6098     grid $top.rev x -pady 10
6099     label $top.flab -text "Output file:"
6100     entry $top.fname -width 60
6101     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
6102     incr patchnum
6103     grid $top.flab $top.fname -sticky w
6104     frame $top.buts
6105     button $top.buts.gen -text "Generate" -command mkpatchgo
6106     button $top.buts.can -text "Cancel" -command mkpatchcan
6107     grid $top.buts.gen $top.buts.can
6108     grid columnconfigure $top.buts 0 -weight 1 -uniform a
6109     grid columnconfigure $top.buts 1 -weight 1 -uniform a
6110     grid $top.buts - -pady 10 -sticky ew
6111     focus $top.fname
6112 }
6113
6114 proc mkpatchrev {} {
6115     global patchtop
6116
6117     set oldid [$patchtop.fromsha1 get]
6118     set oldhead [$patchtop.fromhead get]
6119     set newid [$patchtop.tosha1 get]
6120     set newhead [$patchtop.tohead get]
6121     foreach e [list fromsha1 fromhead tosha1 tohead] \
6122             v [list $newid $newhead $oldid $oldhead] {
6123         $patchtop.$e conf -state normal
6124         $patchtop.$e delete 0 end
6125         $patchtop.$e insert 0 $v
6126         $patchtop.$e conf -state readonly
6127     }
6128 }
6129
6130 proc mkpatchgo {} {
6131     global patchtop nullid nullid2
6132
6133     set oldid [$patchtop.fromsha1 get]
6134     set newid [$patchtop.tosha1 get]
6135     set fname [$patchtop.fname get]
6136     set cmd [diffcmd [list $oldid $newid] -p]
6137     # trim off the initial "|"
6138     set cmd [lrange $cmd 1 end]
6139     lappend cmd >$fname &
6140     if {[catch {eval exec $cmd} err]} {
6141         error_popup "Error creating patch: $err"
6142     }
6143     catch {destroy $patchtop}
6144     unset patchtop
6145 }
6146
6147 proc mkpatchcan {} {
6148     global patchtop
6149
6150     catch {destroy $patchtop}
6151     unset patchtop
6152 }
6153
6154 proc mktag {} {
6155     global rowmenuid mktagtop commitinfo
6156
6157     set top .maketag
6158     set mktagtop $top
6159     catch {destroy $top}
6160     toplevel $top
6161     label $top.title -text "Create tag"
6162     grid $top.title - -pady 10
6163     label $top.id -text "ID:"
6164     entry $top.sha1 -width 40 -relief flat
6165     $top.sha1 insert 0 $rowmenuid
6166     $top.sha1 conf -state readonly
6167     grid $top.id $top.sha1 -sticky w
6168     entry $top.head -width 60 -relief flat
6169     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6170     $top.head conf -state readonly
6171     grid x $top.head -sticky w
6172     label $top.tlab -text "Tag name:"
6173     entry $top.tag -width 60
6174     grid $top.tlab $top.tag -sticky w
6175     frame $top.buts
6176     button $top.buts.gen -text "Create" -command mktaggo
6177     button $top.buts.can -text "Cancel" -command mktagcan
6178     grid $top.buts.gen $top.buts.can
6179     grid columnconfigure $top.buts 0 -weight 1 -uniform a
6180     grid columnconfigure $top.buts 1 -weight 1 -uniform a
6181     grid $top.buts - -pady 10 -sticky ew
6182     focus $top.tag
6183 }
6184
6185 proc domktag {} {
6186     global mktagtop env tagids idtags
6187
6188     set id [$mktagtop.sha1 get]
6189     set tag [$mktagtop.tag get]
6190     if {$tag == {}} {
6191         error_popup "No tag name specified"
6192         return
6193     }
6194     if {[info exists tagids($tag)]} {
6195         error_popup "Tag \"$tag\" already exists"
6196         return
6197     }
6198     if {[catch {
6199         set dir [gitdir]
6200         set fname [file join $dir "refs/tags" $tag]
6201         set f [open $fname w]
6202         puts $f $id
6203         close $f
6204     } err]} {
6205         error_popup "Error creating tag: $err"
6206         return
6207     }
6208
6209     set tagids($tag) $id
6210     lappend idtags($id) $tag
6211     redrawtags $id
6212     addedtag $id
6213     dispneartags 0
6214     run refill_reflist
6215 }
6216
6217 proc redrawtags {id} {
6218     global canv linehtag commitrow idpos selectedline curview
6219     global canvxmax iddrawn
6220
6221     if {![info exists commitrow($curview,$id)]} return
6222     if {![info exists iddrawn($id)]} return
6223     drawcommits $commitrow($curview,$id)
6224     $canv delete tag.$id
6225     set xt [eval drawtags $id $idpos($id)]
6226     $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
6227     set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
6228     set xr [expr {$xt + [font measure mainfont $text]}]
6229     if {$xr > $canvxmax} {
6230         set canvxmax $xr
6231         setcanvscroll
6232     }
6233     if {[info exists selectedline]
6234         && $selectedline == $commitrow($curview,$id)} {
6235         selectline $selectedline 0
6236     }
6237 }
6238
6239 proc mktagcan {} {
6240     global mktagtop
6241
6242     catch {destroy $mktagtop}
6243     unset mktagtop
6244 }
6245
6246 proc mktaggo {} {
6247     domktag
6248     mktagcan
6249 }
6250
6251 proc writecommit {} {
6252     global rowmenuid wrcomtop commitinfo wrcomcmd
6253
6254     set top .writecommit
6255     set wrcomtop $top
6256     catch {destroy $top}
6257     toplevel $top
6258     label $top.title -text "Write commit to file"
6259     grid $top.title - -pady 10
6260     label $top.id -text "ID:"
6261     entry $top.sha1 -width 40 -relief flat
6262     $top.sha1 insert 0 $rowmenuid
6263     $top.sha1 conf -state readonly
6264     grid $top.id $top.sha1 -sticky w
6265     entry $top.head -width 60 -relief flat
6266     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6267     $top.head conf -state readonly
6268     grid x $top.head -sticky w
6269     label $top.clab -text "Command:"
6270     entry $top.cmd -width 60 -textvariable wrcomcmd
6271     grid $top.clab $top.cmd -sticky w -pady 10
6272     label $top.flab -text "Output file:"
6273     entry $top.fname -width 60
6274     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
6275     grid $top.flab $top.fname -sticky w
6276     frame $top.buts
6277     button $top.buts.gen -text "Write" -command wrcomgo
6278     button $top.buts.can -text "Cancel" -command wrcomcan
6279     grid $top.buts.gen $top.buts.can
6280     grid columnconfigure $top.buts 0 -weight 1 -uniform a
6281     grid columnconfigure $top.buts 1 -weight 1 -uniform a
6282     grid $top.buts - -pady 10 -sticky ew
6283     focus $top.fname
6284 }
6285
6286 proc wrcomgo {} {
6287     global wrcomtop
6288
6289     set id [$wrcomtop.sha1 get]
6290     set cmd "echo $id | [$wrcomtop.cmd get]"
6291     set fname [$wrcomtop.fname get]
6292     if {[catch {exec sh -c $cmd >$fname &} err]} {
6293         error_popup "Error writing commit: $err"
6294     }
6295     catch {destroy $wrcomtop}
6296     unset wrcomtop
6297 }
6298
6299 proc wrcomcan {} {
6300     global wrcomtop
6301
6302     catch {destroy $wrcomtop}
6303     unset wrcomtop
6304 }
6305
6306 proc mkbranch {} {
6307     global rowmenuid mkbrtop
6308
6309     set top .makebranch
6310     catch {destroy $top}
6311     toplevel $top
6312     label $top.title -text "Create new branch"
6313     grid $top.title - -pady 10
6314     label $top.id -text "ID:"
6315     entry $top.sha1 -width 40 -relief flat
6316     $top.sha1 insert 0 $rowmenuid
6317     $top.sha1 conf -state readonly
6318     grid $top.id $top.sha1 -sticky w
6319     label $top.nlab -text "Name:"
6320     entry $top.name -width 40
6321     grid $top.nlab $top.name -sticky w
6322     frame $top.buts
6323     button $top.buts.go -text "Create" -command [list mkbrgo $top]
6324     button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
6325     grid $top.buts.go $top.buts.can
6326     grid columnconfigure $top.buts 0 -weight 1 -uniform a
6327     grid columnconfigure $top.buts 1 -weight 1 -uniform a
6328     grid $top.buts - -pady 10 -sticky ew
6329     focus $top.name
6330 }
6331
6332 proc mkbrgo {top} {
6333     global headids idheads
6334
6335     set name [$top.name get]
6336     set id [$top.sha1 get]
6337     if {$name eq {}} {
6338         error_popup "Please specify a name for the new branch"
6339         return
6340     }
6341     catch {destroy $top}
6342     nowbusy newbranch
6343     update
6344     if {[catch {
6345         exec git branch $name $id
6346     } err]} {
6347         notbusy newbranch
6348         error_popup $err
6349     } else {
6350         set headids($name) $id
6351         lappend idheads($id) $name
6352         addedhead $id $name
6353         notbusy newbranch
6354         redrawtags $id
6355         dispneartags 0
6356         run refill_reflist
6357     }
6358 }
6359
6360 proc cherrypick {} {
6361     global rowmenuid curview commitrow
6362     global mainhead
6363
6364     set oldhead [exec git rev-parse HEAD]
6365     set dheads [descheads $rowmenuid]
6366     if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
6367         set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
6368                         included in branch $mainhead -- really re-apply it?"]
6369         if {!$ok} return
6370     }
6371     nowbusy cherrypick
6372     update
6373     # Unfortunately git-cherry-pick writes stuff to stderr even when
6374     # no error occurs, and exec takes that as an indication of error...
6375     if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
6376         notbusy cherrypick
6377         error_popup $err
6378         return
6379     }
6380     set newhead [exec git rev-parse HEAD]
6381     if {$newhead eq $oldhead} {
6382         notbusy cherrypick
6383         error_popup "No changes committed"
6384         return
6385     }
6386     addnewchild $newhead $oldhead
6387     if {[info exists commitrow($curview,$oldhead)]} {
6388         insertrow $commitrow($curview,$oldhead) $newhead
6389         if {$mainhead ne {}} {
6390             movehead $newhead $mainhead
6391             movedhead $newhead $mainhead
6392         }
6393         redrawtags $oldhead
6394         redrawtags $newhead
6395     }
6396     notbusy cherrypick
6397 }
6398
6399 proc resethead {} {
6400     global mainheadid mainhead rowmenuid confirm_ok resettype
6401
6402     set confirm_ok 0
6403     set w ".confirmreset"
6404     toplevel $w
6405     wm transient $w .
6406     wm title $w "Confirm reset"
6407     message $w.m -text \
6408         "Reset branch $mainhead to [string range $rowmenuid 0 7]?" \
6409         -justify center -aspect 1000
6410     pack $w.m -side top -fill x -padx 20 -pady 20
6411     frame $w.f -relief sunken -border 2
6412     message $w.f.rt -text "Reset type:" -aspect 1000
6413     grid $w.f.rt -sticky w
6414     set resettype mixed
6415     radiobutton $w.f.soft -value soft -variable resettype -justify left \
6416         -text "Soft: Leave working tree and index untouched"
6417     grid $w.f.soft -sticky w
6418     radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
6419         -text "Mixed: Leave working tree untouched, reset index"
6420     grid $w.f.mixed -sticky w
6421     radiobutton $w.f.hard -value hard -variable resettype -justify left \
6422         -text "Hard: Reset working tree and index\n(discard ALL local changes)"
6423     grid $w.f.hard -sticky w
6424     pack $w.f -side top -fill x
6425     button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
6426     pack $w.ok -side left -fill x -padx 20 -pady 20
6427     button $w.cancel -text Cancel -command "destroy $w"
6428     pack $w.cancel -side right -fill x -padx 20 -pady 20
6429     bind $w <Visibility> "grab $w; focus $w"
6430     tkwait window $w
6431     if {!$confirm_ok} return
6432     if {[catch {set fd [open \
6433             [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6434         error_popup $err
6435     } else {
6436         dohidelocalchanges
6437         set w ".resetprogress"
6438         filerun $fd [list readresetstat $fd $w]
6439         toplevel $w
6440         wm transient $w
6441         wm title $w "Reset progress"
6442         message $w.m -text "Reset in progress, please wait..." \
6443             -justify center -aspect 1000
6444         pack $w.m -side top -fill x -padx 20 -pady 5
6445         canvas $w.c -width 150 -height 20 -bg white
6446         $w.c create rect 0 0 0 20 -fill green -tags rect
6447         pack $w.c -side top -fill x -padx 20 -pady 5 -expand 1
6448         nowbusy reset
6449     }
6450 }
6451
6452 proc readresetstat {fd w} {
6453     global mainhead mainheadid showlocalchanges
6454
6455     if {[gets $fd line] >= 0} {
6456         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
6457             set x [expr {($m * 150) / $n}]
6458             $w.c coords rect 0 0 $x 20
6459         }
6460         return 1
6461     }
6462     destroy $w
6463     notbusy reset
6464     if {[catch {close $fd} err]} {
6465         error_popup $err
6466     }
6467     set oldhead $mainheadid
6468     set newhead [exec git rev-parse HEAD]
6469     if {$newhead ne $oldhead} {
6470         movehead $newhead $mainhead
6471         movedhead $newhead $mainhead
6472         set mainheadid $newhead
6473         redrawtags $oldhead
6474         redrawtags $newhead
6475     }
6476     if {$showlocalchanges} {
6477         doshowlocalchanges
6478     }
6479     return 0
6480 }
6481
6482 # context menu for a head
6483 proc headmenu {x y id head} {
6484     global headmenuid headmenuhead headctxmenu mainhead
6485
6486     stopfinding
6487     set headmenuid $id
6488     set headmenuhead $head
6489     set state normal
6490     if {$head eq $mainhead} {
6491         set state disabled
6492     }
6493     $headctxmenu entryconfigure 0 -state $state
6494     $headctxmenu entryconfigure 1 -state $state
6495     tk_popup $headctxmenu $x $y
6496 }
6497
6498 proc cobranch {} {
6499     global headmenuid headmenuhead mainhead headids
6500     global showlocalchanges mainheadid
6501
6502     # check the tree is clean first??
6503     set oldmainhead $mainhead
6504     nowbusy checkout
6505     update
6506     dohidelocalchanges
6507     if {[catch {
6508         exec git checkout -q $headmenuhead
6509     } err]} {
6510         notbusy checkout
6511         error_popup $err
6512     } else {
6513         notbusy checkout
6514         set mainhead $headmenuhead
6515         set mainheadid $headmenuid
6516         if {[info exists headids($oldmainhead)]} {
6517             redrawtags $headids($oldmainhead)
6518         }
6519         redrawtags $headmenuid
6520     }
6521     if {$showlocalchanges} {
6522         dodiffindex
6523     }
6524 }
6525
6526 proc rmbranch {} {
6527     global headmenuid headmenuhead mainhead
6528     global idheads
6529
6530     set head $headmenuhead
6531     set id $headmenuid
6532     # this check shouldn't be needed any more...
6533     if {$head eq $mainhead} {
6534         error_popup "Cannot delete the currently checked-out branch"
6535         return
6536     }
6537     set dheads [descheads $id]
6538     if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
6539         # the stuff on this branch isn't on any other branch
6540         if {![confirm_popup "The commits on branch $head aren't on any other\
6541                         branch.\nReally delete branch $head?"]} return
6542     }
6543     nowbusy rmbranch
6544     update
6545     if {[catch {exec git branch -D $head} err]} {
6546         notbusy rmbranch
6547         error_popup $err
6548         return
6549     }
6550     removehead $id $head
6551     removedhead $id $head
6552     redrawtags $id
6553     notbusy rmbranch
6554     dispneartags 0
6555     run refill_reflist
6556 }
6557
6558 # Display a list of tags and heads
6559 proc showrefs {} {
6560     global showrefstop bgcolor fgcolor selectbgcolor
6561     global bglist fglist reflistfilter reflist maincursor
6562
6563     set top .showrefs
6564     set showrefstop $top
6565     if {[winfo exists $top]} {
6566         raise $top
6567         refill_reflist
6568         return
6569     }
6570     toplevel $top
6571     wm title $top "Tags and heads: [file tail [pwd]]"
6572     text $top.list -background $bgcolor -foreground $fgcolor \
6573         -selectbackground $selectbgcolor -font mainfont \
6574         -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
6575         -width 30 -height 20 -cursor $maincursor \
6576         -spacing1 1 -spacing3 1 -state disabled
6577     $top.list tag configure highlight -background $selectbgcolor
6578     lappend bglist $top.list
6579     lappend fglist $top.list
6580     scrollbar $top.ysb -command "$top.list yview" -orient vertical
6581     scrollbar $top.xsb -command "$top.list xview" -orient horizontal
6582     grid $top.list $top.ysb -sticky nsew
6583     grid $top.xsb x -sticky ew
6584     frame $top.f
6585     label $top.f.l -text "Filter: " -font uifont
6586     entry $top.f.e -width 20 -textvariable reflistfilter -font uifont
6587     set reflistfilter "*"
6588     trace add variable reflistfilter write reflistfilter_change
6589     pack $top.f.e -side right -fill x -expand 1
6590     pack $top.f.l -side left
6591     grid $top.f - -sticky ew -pady 2
6592     button $top.close -command [list destroy $top] -text "Close" \
6593         -font uifont
6594     grid $top.close -
6595     grid columnconfigure $top 0 -weight 1
6596     grid rowconfigure $top 0 -weight 1
6597     bind $top.list <1> {break}
6598     bind $top.list <B1-Motion> {break}
6599     bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
6600     set reflist {}
6601     refill_reflist
6602 }
6603
6604 proc sel_reflist {w x y} {
6605     global showrefstop reflist headids tagids otherrefids
6606
6607     if {![winfo exists $showrefstop]} return
6608     set l [lindex [split [$w index "@$x,$y"] "."] 0]
6609     set ref [lindex $reflist [expr {$l-1}]]
6610     set n [lindex $ref 0]
6611     switch -- [lindex $ref 1] {
6612         "H" {selbyid $headids($n)}
6613         "T" {selbyid $tagids($n)}
6614         "o" {selbyid $otherrefids($n)}
6615     }
6616     $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
6617 }
6618
6619 proc unsel_reflist {} {
6620     global showrefstop
6621
6622     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6623     $showrefstop.list tag remove highlight 0.0 end
6624 }
6625
6626 proc reflistfilter_change {n1 n2 op} {
6627     global reflistfilter
6628
6629     after cancel refill_reflist
6630     after 200 refill_reflist
6631 }
6632
6633 proc refill_reflist {} {
6634     global reflist reflistfilter showrefstop headids tagids otherrefids
6635     global commitrow curview commitinterest
6636
6637     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6638     set refs {}
6639     foreach n [array names headids] {
6640         if {[string match $reflistfilter $n]} {
6641             if {[info exists commitrow($curview,$headids($n))]} {
6642                 lappend refs [list $n H]
6643             } else {
6644                 set commitinterest($headids($n)) {run refill_reflist}
6645             }
6646         }
6647     }
6648     foreach n [array names tagids] {
6649         if {[string match $reflistfilter $n]} {
6650             if {[info exists commitrow($curview,$tagids($n))]} {
6651                 lappend refs [list $n T]
6652             } else {
6653                 set commitinterest($tagids($n)) {run refill_reflist}
6654             }
6655         }
6656     }
6657     foreach n [array names otherrefids] {
6658         if {[string match $reflistfilter $n]} {
6659             if {[info exists commitrow($curview,$otherrefids($n))]} {
6660                 lappend refs [list $n o]
6661             } else {
6662                 set commitinterest($otherrefids($n)) {run refill_reflist}
6663             }
6664         }
6665     }
6666     set refs [lsort -index 0 $refs]
6667     if {$refs eq $reflist} return
6668
6669     # Update the contents of $showrefstop.list according to the
6670     # differences between $reflist (old) and $refs (new)
6671     $showrefstop.list conf -state normal
6672     $showrefstop.list insert end "\n"
6673     set i 0
6674     set j 0
6675     while {$i < [llength $reflist] || $j < [llength $refs]} {
6676         if {$i < [llength $reflist]} {
6677             if {$j < [llength $refs]} {
6678                 set cmp [string compare [lindex $reflist $i 0] \
6679                              [lindex $refs $j 0]]
6680                 if {$cmp == 0} {
6681                     set cmp [string compare [lindex $reflist $i 1] \
6682                                  [lindex $refs $j 1]]
6683                 }
6684             } else {
6685                 set cmp -1
6686             }
6687         } else {
6688             set cmp 1
6689         }
6690         switch -- $cmp {
6691             -1 {
6692                 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
6693                 incr i
6694             }
6695             0 {
6696                 incr i
6697                 incr j
6698             }
6699             1 {
6700                 set l [expr {$j + 1}]
6701                 $showrefstop.list image create $l.0 -align baseline \
6702                     -image reficon-[lindex $refs $j 1] -padx 2
6703                 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
6704                 incr j
6705             }
6706         }
6707     }
6708     set reflist $refs
6709     # delete last newline
6710     $showrefstop.list delete end-2c end-1c
6711     $showrefstop.list conf -state disabled
6712 }
6713
6714 # Stuff for finding nearby tags
6715 proc getallcommits {} {
6716     global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
6717     global idheads idtags idotherrefs allparents tagobjid
6718
6719     if {![info exists allcommits]} {
6720         set nextarc 0
6721         set allcommits 0
6722         set seeds {}
6723         set allcwait 0
6724         set cachedarcs 0
6725         set allccache [file join [gitdir] "gitk.cache"]
6726         if {![catch {
6727             set f [open $allccache r]
6728             set allcwait 1
6729             getcache $f
6730         }]} return
6731     }
6732
6733     if {$allcwait} {
6734         return
6735     }
6736     set cmd [list | git rev-list --parents]
6737     set allcupdate [expr {$seeds ne {}}]
6738     if {!$allcupdate} {
6739         set ids "--all"
6740     } else {
6741         set refs [concat [array names idheads] [array names idtags] \
6742                       [array names idotherrefs]]
6743         set ids {}
6744         set tagobjs {}
6745         foreach name [array names tagobjid] {
6746             lappend tagobjs $tagobjid($name)
6747         }
6748         foreach id [lsort -unique $refs] {
6749             if {![info exists allparents($id)] &&
6750                 [lsearch -exact $tagobjs $id] < 0} {
6751                 lappend ids $id
6752             }
6753         }
6754         if {$ids ne {}} {
6755             foreach id $seeds {
6756                 lappend ids "^$id"
6757             }
6758         }
6759     }
6760     if {$ids ne {}} {
6761         set fd [open [concat $cmd $ids] r]
6762         fconfigure $fd -blocking 0
6763         incr allcommits
6764         nowbusy allcommits
6765         filerun $fd [list getallclines $fd]
6766     } else {
6767         dispneartags 0
6768     }
6769 }
6770
6771 # Since most commits have 1 parent and 1 child, we group strings of
6772 # such commits into "arcs" joining branch/merge points (BMPs), which
6773 # are commits that either don't have 1 parent or don't have 1 child.
6774 #
6775 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6776 # arcout(id) - outgoing arcs for BMP
6777 # arcids(a) - list of IDs on arc including end but not start
6778 # arcstart(a) - BMP ID at start of arc
6779 # arcend(a) - BMP ID at end of arc
6780 # growing(a) - arc a is still growing
6781 # arctags(a) - IDs out of arcids (excluding end) that have tags
6782 # archeads(a) - IDs out of arcids (excluding end) that have heads
6783 # The start of an arc is at the descendent end, so "incoming" means
6784 # coming from descendents, and "outgoing" means going towards ancestors.
6785
6786 proc getallclines {fd} {
6787     global allparents allchildren idtags idheads nextarc
6788     global arcnos arcids arctags arcout arcend arcstart archeads growing
6789     global seeds allcommits cachedarcs allcupdate
6790
6791     set nid 0
6792     while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6793         set id [lindex $line 0]
6794         if {[info exists allparents($id)]} {
6795             # seen it already
6796             continue
6797         }
6798         set cachedarcs 0
6799         set olds [lrange $line 1 end]
6800         set allparents($id) $olds
6801         if {![info exists allchildren($id)]} {
6802             set allchildren($id) {}
6803             set arcnos($id) {}
6804             lappend seeds $id
6805         } else {
6806             set a $arcnos($id)
6807             if {[llength $olds] == 1 && [llength $a] == 1} {
6808                 lappend arcids($a) $id
6809                 if {[info exists idtags($id)]} {
6810                     lappend arctags($a) $id
6811                 }
6812                 if {[info exists idheads($id)]} {
6813                     lappend archeads($a) $id
6814                 }
6815                 if {[info exists allparents($olds)]} {
6816                     # seen parent already
6817                     if {![info exists arcout($olds)]} {
6818                         splitarc $olds
6819                     }
6820                     lappend arcids($a) $olds
6821                     set arcend($a) $olds
6822                     unset growing($a)
6823                 }
6824                 lappend allchildren($olds) $id
6825                 lappend arcnos($olds) $a
6826                 continue
6827             }
6828         }
6829         foreach a $arcnos($id) {
6830             lappend arcids($a) $id
6831             set arcend($a) $id
6832             unset growing($a)
6833         }
6834
6835         set ao {}
6836         foreach p $olds {
6837             lappend allchildren($p) $id
6838             set a [incr nextarc]
6839             set arcstart($a) $id
6840             set archeads($a) {}
6841             set arctags($a) {}
6842             set archeads($a) {}
6843             set arcids($a) {}
6844             lappend ao $a
6845             set growing($a) 1
6846             if {[info exists allparents($p)]} {
6847                 # seen it already, may need to make a new branch
6848                 if {![info exists arcout($p)]} {
6849                     splitarc $p
6850                 }
6851                 lappend arcids($a) $p
6852                 set arcend($a) $p
6853                 unset growing($a)
6854             }
6855             lappend arcnos($p) $a
6856         }
6857         set arcout($id) $ao
6858     }
6859     if {$nid > 0} {
6860         global cached_dheads cached_dtags cached_atags
6861         catch {unset cached_dheads}
6862         catch {unset cached_dtags}
6863         catch {unset cached_atags}
6864     }
6865     if {![eof $fd]} {
6866         return [expr {$nid >= 1000? 2: 1}]
6867     }
6868     set cacheok 1
6869     if {[catch {
6870         fconfigure $fd -blocking 1
6871         close $fd
6872     } err]} {
6873         # got an error reading the list of commits
6874         # if we were updating, try rereading the whole thing again
6875         if {$allcupdate} {
6876             incr allcommits -1
6877             dropcache $err
6878             return
6879         }
6880         error_popup "Error reading commit topology information;\
6881                 branch and preceding/following tag information\
6882                 will be incomplete.\n($err)"
6883         set cacheok 0
6884     }
6885     if {[incr allcommits -1] == 0} {
6886         notbusy allcommits
6887         if {$cacheok} {
6888             run savecache
6889         }
6890     }
6891     dispneartags 0
6892     return 0
6893 }
6894
6895 proc recalcarc {a} {
6896     global arctags archeads arcids idtags idheads
6897
6898     set at {}
6899     set ah {}
6900     foreach id [lrange $arcids($a) 0 end-1] {
6901         if {[info exists idtags($id)]} {
6902             lappend at $id
6903         }
6904         if {[info exists idheads($id)]} {
6905             lappend ah $id
6906         }
6907     }
6908     set arctags($a) $at
6909     set archeads($a) $ah
6910 }
6911
6912 proc splitarc {p} {
6913     global arcnos arcids nextarc arctags archeads idtags idheads
6914     global arcstart arcend arcout allparents growing
6915
6916     set a $arcnos($p)
6917     if {[llength $a] != 1} {
6918         puts "oops splitarc called but [llength $a] arcs already"
6919         return
6920     }
6921     set a [lindex $a 0]
6922     set i [lsearch -exact $arcids($a) $p]
6923     if {$i < 0} {
6924         puts "oops splitarc $p not in arc $a"
6925         return
6926     }
6927     set na [incr nextarc]
6928     if {[info exists arcend($a)]} {
6929         set arcend($na) $arcend($a)
6930     } else {
6931         set l [lindex $allparents([lindex $arcids($a) end]) 0]
6932         set j [lsearch -exact $arcnos($l) $a]
6933         set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6934     }
6935     set tail [lrange $arcids($a) [expr {$i+1}] end]
6936     set arcids($a) [lrange $arcids($a) 0 $i]
6937     set arcend($a) $p
6938     set arcstart($na) $p
6939     set arcout($p) $na
6940     set arcids($na) $tail
6941     if {[info exists growing($a)]} {
6942         set growing($na) 1
6943         unset growing($a)
6944     }
6945
6946     foreach id $tail {
6947         if {[llength $arcnos($id)] == 1} {
6948             set arcnos($id) $na
6949         } else {
6950             set j [lsearch -exact $arcnos($id) $a]
6951             set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6952         }
6953     }
6954
6955     # reconstruct tags and heads lists
6956     if {$arctags($a) ne {} || $archeads($a) ne {}} {
6957         recalcarc $a
6958         recalcarc $na
6959     } else {
6960         set arctags($na) {}
6961         set archeads($na) {}
6962     }
6963 }
6964
6965 # Update things for a new commit added that is a child of one
6966 # existing commit.  Used when cherry-picking.
6967 proc addnewchild {id p} {
6968     global allparents allchildren idtags nextarc
6969     global arcnos arcids arctags arcout arcend arcstart archeads growing
6970     global seeds allcommits
6971
6972     if {![info exists allcommits]} return
6973     set allparents($id) [list $p]
6974     set allchildren($id) {}
6975     set arcnos($id) {}
6976     lappend seeds $id
6977     lappend allchildren($p) $id
6978     set a [incr nextarc]
6979     set arcstart($a) $id
6980     set archeads($a) {}
6981     set arctags($a) {}
6982     set arcids($a) [list $p]
6983     set arcend($a) $p
6984     if {![info exists arcout($p)]} {
6985         splitarc $p
6986     }
6987     lappend arcnos($p) $a
6988     set arcout($id) [list $a]
6989 }
6990
6991 # This implements a cache for the topology information.
6992 # The cache saves, for each arc, the start and end of the arc,
6993 # the ids on the arc, and the outgoing arcs from the end.
6994 proc readcache {f} {
6995     global arcnos arcids arcout arcstart arcend arctags archeads nextarc
6996     global idtags idheads allparents cachedarcs possible_seeds seeds growing
6997     global allcwait
6998
6999     set a $nextarc
7000     set lim $cachedarcs
7001     if {$lim - $a > 500} {
7002         set lim [expr {$a + 500}]
7003     }
7004     if {[catch {
7005         if {$a == $lim} {
7006             # finish reading the cache and setting up arctags, etc.
7007             set line [gets $f]
7008             if {$line ne "1"} {error "bad final version"}
7009             close $f
7010             foreach id [array names idtags] {
7011                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
7012                     [llength $allparents($id)] == 1} {
7013                     set a [lindex $arcnos($id) 0]
7014                     if {$arctags($a) eq {}} {
7015                         recalcarc $a
7016                     }
7017                 }
7018             }
7019             foreach id [array names idheads] {
7020                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
7021                     [llength $allparents($id)] == 1} {
7022                     set a [lindex $arcnos($id) 0]
7023                     if {$archeads($a) eq {}} {
7024                         recalcarc $a
7025                     }
7026                 }
7027             }
7028             foreach id [lsort -unique $possible_seeds] {
7029                 if {$arcnos($id) eq {}} {
7030                     lappend seeds $id
7031                 }
7032             }
7033             set allcwait 0
7034         } else {
7035             while {[incr a] <= $lim} {
7036                 set line [gets $f]
7037                 if {[llength $line] != 3} {error "bad line"}
7038                 set s [lindex $line 0]
7039                 set arcstart($a) $s
7040                 lappend arcout($s) $a
7041                 if {![info exists arcnos($s)]} {
7042                     lappend possible_seeds $s
7043                     set arcnos($s) {}
7044                 }
7045                 set e [lindex $line 1]
7046                 if {$e eq {}} {
7047                     set growing($a) 1
7048                 } else {
7049                     set arcend($a) $e
7050                     if {![info exists arcout($e)]} {
7051                         set arcout($e) {}
7052                     }
7053                 }
7054                 set arcids($a) [lindex $line 2]
7055                 foreach id $arcids($a) {
7056                     lappend allparents($s) $id
7057                     set s $id
7058                     lappend arcnos($id) $a
7059                 }
7060                 if {![info exists allparents($s)]} {
7061                     set allparents($s) {}
7062                 }
7063                 set arctags($a) {}
7064                 set archeads($a) {}
7065             }
7066             set nextarc [expr {$a - 1}]
7067         }
7068     } err]} {
7069         dropcache $err
7070         return 0
7071     }
7072     if {!$allcwait} {
7073         getallcommits
7074     }
7075     return $allcwait
7076 }
7077
7078 proc getcache {f} {
7079     global nextarc cachedarcs possible_seeds
7080
7081     if {[catch {
7082         set line [gets $f]
7083         if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
7084         # make sure it's an integer
7085         set cachedarcs [expr {int([lindex $line 1])}]
7086         if {$cachedarcs < 0} {error "bad number of arcs"}
7087         set nextarc 0
7088         set possible_seeds {}
7089         run readcache $f
7090     } err]} {
7091         dropcache $err
7092     }
7093     return 0
7094 }
7095
7096 proc dropcache {err} {
7097     global allcwait nextarc cachedarcs seeds
7098
7099     #puts "dropping cache ($err)"
7100     foreach v {arcnos arcout arcids arcstart arcend growing \
7101                    arctags archeads allparents allchildren} {
7102         global $v
7103         catch {unset $v}
7104     }
7105     set allcwait 0
7106     set nextarc 0
7107     set cachedarcs 0
7108     set seeds {}
7109     getallcommits
7110 }
7111
7112 proc writecache {f} {
7113     global cachearc cachedarcs allccache
7114     global arcstart arcend arcnos arcids arcout
7115
7116     set a $cachearc
7117     set lim $cachedarcs
7118     if {$lim - $a > 1000} {
7119         set lim [expr {$a + 1000}]
7120     }
7121     if {[catch {
7122         while {[incr a] <= $lim} {
7123             if {[info exists arcend($a)]} {
7124                 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
7125             } else {
7126                 puts $f [list $arcstart($a) {} $arcids($a)]
7127             }
7128         }
7129     } err]} {
7130         catch {close $f}
7131         catch {file delete $allccache}
7132         #puts "writing cache failed ($err)"
7133         return 0
7134     }
7135     set cachearc [expr {$a - 1}]
7136     if {$a > $cachedarcs} {
7137         puts $f "1"
7138         close $f
7139         return 0
7140     }
7141     return 1
7142 }
7143
7144 proc savecache {} {
7145     global nextarc cachedarcs cachearc allccache
7146
7147     if {$nextarc == $cachedarcs} return
7148     set cachearc 0
7149     set cachedarcs $nextarc
7150     catch {
7151         set f [open $allccache w]
7152         puts $f [list 1 $cachedarcs]
7153         run writecache $f
7154     }
7155 }
7156
7157 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
7158 # or 0 if neither is true.
7159 proc anc_or_desc {a b} {
7160     global arcout arcstart arcend arcnos cached_isanc
7161
7162     if {$arcnos($a) eq $arcnos($b)} {
7163         # Both are on the same arc(s); either both are the same BMP,
7164         # or if one is not a BMP, the other is also not a BMP or is
7165         # the BMP at end of the arc (and it only has 1 incoming arc).
7166         # Or both can be BMPs with no incoming arcs.
7167         if {$a eq $b || $arcnos($a) eq {}} {
7168             return 0
7169         }
7170         # assert {[llength $arcnos($a)] == 1}
7171         set arc [lindex $arcnos($a) 0]
7172         set i [lsearch -exact $arcids($arc) $a]
7173         set j [lsearch -exact $arcids($arc) $b]
7174         if {$i < 0 || $i > $j} {
7175             return 1
7176         } else {
7177             return -1
7178         }
7179     }
7180
7181     if {![info exists arcout($a)]} {
7182         set arc [lindex $arcnos($a) 0]
7183         if {[info exists arcend($arc)]} {
7184             set aend $arcend($arc)
7185         } else {
7186             set aend {}
7187         }
7188         set a $arcstart($arc)
7189     } else {
7190         set aend $a
7191     }
7192     if {![info exists arcout($b)]} {
7193         set arc [lindex $arcnos($b) 0]
7194         if {[info exists arcend($arc)]} {
7195             set bend $arcend($arc)
7196         } else {
7197             set bend {}
7198         }
7199         set b $arcstart($arc)
7200     } else {
7201         set bend $b
7202     }
7203     if {$a eq $bend} {
7204         return 1
7205     }
7206     if {$b eq $aend} {
7207         return -1
7208     }
7209     if {[info exists cached_isanc($a,$bend)]} {
7210         if {$cached_isanc($a,$bend)} {
7211             return 1
7212         }
7213     }
7214     if {[info exists cached_isanc($b,$aend)]} {
7215         if {$cached_isanc($b,$aend)} {
7216             return -1
7217         }
7218         if {[info exists cached_isanc($a,$bend)]} {
7219             return 0
7220         }
7221     }
7222
7223     set todo [list $a $b]
7224     set anc($a) a
7225     set anc($b) b
7226     for {set i 0} {$i < [llength $todo]} {incr i} {
7227         set x [lindex $todo $i]
7228         if {$anc($x) eq {}} {
7229             continue
7230         }
7231         foreach arc $arcnos($x) {
7232             set xd $arcstart($arc)
7233             if {$xd eq $bend} {
7234                 set cached_isanc($a,$bend) 1
7235                 set cached_isanc($b,$aend) 0
7236                 return 1
7237             } elseif {$xd eq $aend} {
7238                 set cached_isanc($b,$aend) 1
7239                 set cached_isanc($a,$bend) 0
7240                 return -1
7241             }
7242             if {![info exists anc($xd)]} {
7243                 set anc($xd) $anc($x)
7244                 lappend todo $xd
7245             } elseif {$anc($xd) ne $anc($x)} {
7246                 set anc($xd) {}
7247             }
7248         }
7249     }
7250     set cached_isanc($a,$bend) 0
7251     set cached_isanc($b,$aend) 0
7252     return 0
7253 }
7254
7255 # This identifies whether $desc has an ancestor that is
7256 # a growing tip of the graph and which is not an ancestor of $anc
7257 # and returns 0 if so and 1 if not.
7258 # If we subsequently discover a tag on such a growing tip, and that
7259 # turns out to be a descendent of $anc (which it could, since we
7260 # don't necessarily see children before parents), then $desc
7261 # isn't a good choice to display as a descendent tag of
7262 # $anc (since it is the descendent of another tag which is
7263 # a descendent of $anc).  Similarly, $anc isn't a good choice to
7264 # display as a ancestor tag of $desc.
7265 #
7266 proc is_certain {desc anc} {
7267     global arcnos arcout arcstart arcend growing problems
7268
7269     set certain {}
7270     if {[llength $arcnos($anc)] == 1} {
7271         # tags on the same arc are certain
7272         if {$arcnos($desc) eq $arcnos($anc)} {
7273             return 1
7274         }
7275         if {![info exists arcout($anc)]} {
7276             # if $anc is partway along an arc, use the start of the arc instead
7277             set a [lindex $arcnos($anc) 0]
7278             set anc $arcstart($a)
7279         }
7280     }
7281     if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
7282         set x $desc
7283     } else {
7284         set a [lindex $arcnos($desc) 0]
7285         set x $arcend($a)
7286     }
7287     if {$x == $anc} {
7288         return 1
7289     }
7290     set anclist [list $x]
7291     set dl($x) 1
7292     set nnh 1
7293     set ngrowanc 0
7294     for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
7295         set x [lindex $anclist $i]
7296         if {$dl($x)} {
7297             incr nnh -1
7298         }
7299         set done($x) 1
7300         foreach a $arcout($x) {
7301             if {[info exists growing($a)]} {
7302                 if {![info exists growanc($x)] && $dl($x)} {
7303                     set growanc($x) 1
7304                     incr ngrowanc
7305                 }
7306             } else {
7307                 set y $arcend($a)
7308                 if {[info exists dl($y)]} {
7309                     if {$dl($y)} {
7310                         if {!$dl($x)} {
7311                             set dl($y) 0
7312                             if {![info exists done($y)]} {
7313                                 incr nnh -1
7314                             }
7315                             if {[info exists growanc($x)]} {
7316                                 incr ngrowanc -1
7317                             }
7318                             set xl [list $y]
7319                             for {set k 0} {$k < [llength $xl]} {incr k} {
7320                                 set z [lindex $xl $k]
7321                                 foreach c $arcout($z) {
7322                                     if {[info exists arcend($c)]} {
7323                                         set v $arcend($c)
7324                                         if {[info exists dl($v)] && $dl($v)} {
7325                                             set dl($v) 0
7326                                             if {![info exists done($v)]} {
7327                                                 incr nnh -1
7328                                             }
7329                                             if {[info exists growanc($v)]} {
7330                                                 incr ngrowanc -1
7331                                             }
7332                                             lappend xl $v
7333                                         }
7334                                     }
7335                                 }
7336                             }
7337                         }
7338                     }
7339                 } elseif {$y eq $anc || !$dl($x)} {
7340                     set dl($y) 0
7341                     lappend anclist $y
7342                 } else {
7343                     set dl($y) 1
7344                     lappend anclist $y
7345                     incr nnh
7346                 }
7347             }
7348         }
7349     }
7350     foreach x [array names growanc] {
7351         if {$dl($x)} {
7352             return 0
7353         }
7354         return 0
7355     }
7356     return 1
7357 }
7358
7359 proc validate_arctags {a} {
7360     global arctags idtags
7361
7362     set i -1
7363     set na $arctags($a)
7364     foreach id $arctags($a) {
7365         incr i
7366         if {![info exists idtags($id)]} {
7367             set na [lreplace $na $i $i]
7368             incr i -1
7369         }
7370     }
7371     set arctags($a) $na
7372 }
7373
7374 proc validate_archeads {a} {
7375     global archeads idheads
7376
7377     set i -1
7378     set na $archeads($a)
7379     foreach id $archeads($a) {
7380         incr i
7381         if {![info exists idheads($id)]} {
7382             set na [lreplace $na $i $i]
7383             incr i -1
7384         }
7385     }
7386     set archeads($a) $na
7387 }
7388
7389 # Return the list of IDs that have tags that are descendents of id,
7390 # ignoring IDs that are descendents of IDs already reported.
7391 proc desctags {id} {
7392     global arcnos arcstart arcids arctags idtags allparents
7393     global growing cached_dtags
7394
7395     if {![info exists allparents($id)]} {
7396         return {}
7397     }
7398     set t1 [clock clicks -milliseconds]
7399     set argid $id
7400     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7401         # part-way along an arc; check that arc first
7402         set a [lindex $arcnos($id) 0]
7403         if {$arctags($a) ne {}} {
7404             validate_arctags $a
7405             set i [lsearch -exact $arcids($a) $id]
7406             set tid {}
7407             foreach t $arctags($a) {
7408                 set j [lsearch -exact $arcids($a) $t]
7409                 if {$j >= $i} break
7410                 set tid $t
7411             }
7412             if {$tid ne {}} {
7413                 return $tid
7414             }
7415         }
7416         set id $arcstart($a)
7417         if {[info exists idtags($id)]} {
7418             return $id
7419         }
7420     }
7421     if {[info exists cached_dtags($id)]} {
7422         return $cached_dtags($id)
7423     }
7424
7425     set origid $id
7426     set todo [list $id]
7427     set queued($id) 1
7428     set nc 1
7429     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7430         set id [lindex $todo $i]
7431         set done($id) 1
7432         set ta [info exists hastaggedancestor($id)]
7433         if {!$ta} {
7434             incr nc -1
7435         }
7436         # ignore tags on starting node
7437         if {!$ta && $i > 0} {
7438             if {[info exists idtags($id)]} {
7439                 set tagloc($id) $id
7440                 set ta 1
7441             } elseif {[info exists cached_dtags($id)]} {
7442                 set tagloc($id) $cached_dtags($id)
7443                 set ta 1
7444             }
7445         }
7446         foreach a $arcnos($id) {
7447             set d $arcstart($a)
7448             if {!$ta && $arctags($a) ne {}} {
7449                 validate_arctags $a
7450                 if {$arctags($a) ne {}} {
7451                     lappend tagloc($id) [lindex $arctags($a) end]
7452                 }
7453             }
7454             if {$ta || $arctags($a) ne {}} {
7455                 set tomark [list $d]
7456                 for {set j 0} {$j < [llength $tomark]} {incr j} {
7457                     set dd [lindex $tomark $j]
7458                     if {![info exists hastaggedancestor($dd)]} {
7459                         if {[info exists done($dd)]} {
7460                             foreach b $arcnos($dd) {
7461                                 lappend tomark $arcstart($b)
7462                             }
7463                             if {[info exists tagloc($dd)]} {
7464                                 unset tagloc($dd)
7465                             }
7466                         } elseif {[info exists queued($dd)]} {
7467                             incr nc -1
7468                         }
7469                         set hastaggedancestor($dd) 1
7470                     }
7471                 }
7472             }
7473             if {![info exists queued($d)]} {
7474                 lappend todo $d
7475                 set queued($d) 1
7476                 if {![info exists hastaggedancestor($d)]} {
7477                     incr nc
7478                 }
7479             }
7480         }
7481     }
7482     set tags {}
7483     foreach id [array names tagloc] {
7484         if {![info exists hastaggedancestor($id)]} {
7485             foreach t $tagloc($id) {
7486                 if {[lsearch -exact $tags $t] < 0} {
7487                     lappend tags $t
7488                 }
7489             }
7490         }
7491     }
7492     set t2 [clock clicks -milliseconds]
7493     set loopix $i
7494
7495     # remove tags that are descendents of other tags
7496     for {set i 0} {$i < [llength $tags]} {incr i} {
7497         set a [lindex $tags $i]
7498         for {set j 0} {$j < $i} {incr j} {
7499             set b [lindex $tags $j]
7500             set r [anc_or_desc $a $b]
7501             if {$r == 1} {
7502                 set tags [lreplace $tags $j $j]
7503                 incr j -1
7504                 incr i -1
7505             } elseif {$r == -1} {
7506                 set tags [lreplace $tags $i $i]
7507                 incr i -1
7508                 break
7509             }
7510         }
7511     }
7512
7513     if {[array names growing] ne {}} {
7514         # graph isn't finished, need to check if any tag could get
7515         # eclipsed by another tag coming later.  Simply ignore any
7516         # tags that could later get eclipsed.
7517         set ctags {}
7518         foreach t $tags {
7519             if {[is_certain $t $origid]} {
7520                 lappend ctags $t
7521             }
7522         }
7523         if {$tags eq $ctags} {
7524             set cached_dtags($origid) $tags
7525         } else {
7526             set tags $ctags
7527         }
7528     } else {
7529         set cached_dtags($origid) $tags
7530     }
7531     set t3 [clock clicks -milliseconds]
7532     if {0 && $t3 - $t1 >= 100} {
7533         puts "iterating descendents ($loopix/[llength $todo] nodes) took\
7534             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7535     }
7536     return $tags
7537 }
7538
7539 proc anctags {id} {
7540     global arcnos arcids arcout arcend arctags idtags allparents
7541     global growing cached_atags
7542
7543     if {![info exists allparents($id)]} {
7544         return {}
7545     }
7546     set t1 [clock clicks -milliseconds]
7547     set argid $id
7548     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7549         # part-way along an arc; check that arc first
7550         set a [lindex $arcnos($id) 0]
7551         if {$arctags($a) ne {}} {
7552             validate_arctags $a
7553             set i [lsearch -exact $arcids($a) $id]
7554             foreach t $arctags($a) {
7555                 set j [lsearch -exact $arcids($a) $t]
7556                 if {$j > $i} {
7557                     return $t
7558                 }
7559             }
7560         }
7561         if {![info exists arcend($a)]} {
7562             return {}
7563         }
7564         set id $arcend($a)
7565         if {[info exists idtags($id)]} {
7566             return $id
7567         }
7568     }
7569     if {[info exists cached_atags($id)]} {
7570         return $cached_atags($id)
7571     }
7572
7573     set origid $id
7574     set todo [list $id]
7575     set queued($id) 1
7576     set taglist {}
7577     set nc 1
7578     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7579         set id [lindex $todo $i]
7580         set done($id) 1
7581         set td [info exists hastaggeddescendent($id)]
7582         if {!$td} {
7583             incr nc -1
7584         }
7585         # ignore tags on starting node
7586         if {!$td && $i > 0} {
7587             if {[info exists idtags($id)]} {
7588                 set tagloc($id) $id
7589                 set td 1
7590             } elseif {[info exists cached_atags($id)]} {
7591                 set tagloc($id) $cached_atags($id)
7592                 set td 1
7593             }
7594         }
7595         foreach a $arcout($id) {
7596             if {!$td && $arctags($a) ne {}} {
7597                 validate_arctags $a
7598                 if {$arctags($a) ne {}} {
7599                     lappend tagloc($id) [lindex $arctags($a) 0]
7600                 }
7601             }
7602             if {![info exists arcend($a)]} continue
7603             set d $arcend($a)
7604             if {$td || $arctags($a) ne {}} {
7605                 set tomark [list $d]
7606                 for {set j 0} {$j < [llength $tomark]} {incr j} {
7607                     set dd [lindex $tomark $j]
7608                     if {![info exists hastaggeddescendent($dd)]} {
7609                         if {[info exists done($dd)]} {
7610                             foreach b $arcout($dd) {
7611                                 if {[info exists arcend($b)]} {
7612                                     lappend tomark $arcend($b)
7613                                 }
7614                             }
7615                             if {[info exists tagloc($dd)]} {
7616                                 unset tagloc($dd)
7617                             }
7618                         } elseif {[info exists queued($dd)]} {
7619                             incr nc -1
7620                         }
7621                         set hastaggeddescendent($dd) 1
7622                     }
7623                 }
7624             }
7625             if {![info exists queued($d)]} {
7626                 lappend todo $d
7627                 set queued($d) 1
7628                 if {![info exists hastaggeddescendent($d)]} {
7629                     incr nc
7630                 }
7631             }
7632         }
7633     }
7634     set t2 [clock clicks -milliseconds]
7635     set loopix $i
7636     set tags {}
7637     foreach id [array names tagloc] {
7638         if {![info exists hastaggeddescendent($id)]} {
7639             foreach t $tagloc($id) {
7640                 if {[lsearch -exact $tags $t] < 0} {
7641                     lappend tags $t
7642                 }
7643             }
7644         }
7645     }
7646
7647     # remove tags that are ancestors of other tags
7648     for {set i 0} {$i < [llength $tags]} {incr i} {
7649         set a [lindex $tags $i]
7650         for {set j 0} {$j < $i} {incr j} {
7651             set b [lindex $tags $j]
7652             set r [anc_or_desc $a $b]
7653             if {$r == -1} {
7654                 set tags [lreplace $tags $j $j]
7655                 incr j -1
7656                 incr i -1
7657             } elseif {$r == 1} {
7658                 set tags [lreplace $tags $i $i]
7659                 incr i -1
7660                 break
7661             }
7662         }
7663     }
7664
7665     if {[array names growing] ne {}} {
7666         # graph isn't finished, need to check if any tag could get
7667         # eclipsed by another tag coming later.  Simply ignore any
7668         # tags that could later get eclipsed.
7669         set ctags {}
7670         foreach t $tags {
7671             if {[is_certain $origid $t]} {
7672                 lappend ctags $t
7673             }
7674         }
7675         if {$tags eq $ctags} {
7676             set cached_atags($origid) $tags
7677         } else {
7678             set tags $ctags
7679         }
7680     } else {
7681         set cached_atags($origid) $tags
7682     }
7683     set t3 [clock clicks -milliseconds]
7684     if {0 && $t3 - $t1 >= 100} {
7685         puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
7686             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7687     }
7688     return $tags
7689 }
7690
7691 # Return the list of IDs that have heads that are descendents of id,
7692 # including id itself if it has a head.
7693 proc descheads {id} {
7694     global arcnos arcstart arcids archeads idheads cached_dheads
7695     global allparents
7696
7697     if {![info exists allparents($id)]} {
7698         return {}
7699     }
7700     set aret {}
7701     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7702         # part-way along an arc; check it first
7703         set a [lindex $arcnos($id) 0]
7704         if {$archeads($a) ne {}} {
7705             validate_archeads $a
7706             set i [lsearch -exact $arcids($a) $id]
7707             foreach t $archeads($a) {
7708                 set j [lsearch -exact $arcids($a) $t]
7709                 if {$j > $i} break
7710                 lappend aret $t
7711             }
7712         }
7713         set id $arcstart($a)
7714     }
7715     set origid $id
7716     set todo [list $id]
7717     set seen($id) 1
7718     set ret {}
7719     for {set i 0} {$i < [llength $todo]} {incr i} {
7720         set id [lindex $todo $i]
7721         if {[info exists cached_dheads($id)]} {
7722             set ret [concat $ret $cached_dheads($id)]
7723         } else {
7724             if {[info exists idheads($id)]} {
7725                 lappend ret $id
7726             }
7727             foreach a $arcnos($id) {
7728                 if {$archeads($a) ne {}} {
7729                     validate_archeads $a
7730                     if {$archeads($a) ne {}} {
7731                         set ret [concat $ret $archeads($a)]
7732                     }
7733                 }
7734                 set d $arcstart($a)
7735                 if {![info exists seen($d)]} {
7736                     lappend todo $d
7737                     set seen($d) 1
7738                 }
7739             }
7740         }
7741     }
7742     set ret [lsort -unique $ret]
7743     set cached_dheads($origid) $ret
7744     return [concat $ret $aret]
7745 }
7746
7747 proc addedtag {id} {
7748     global arcnos arcout cached_dtags cached_atags
7749
7750     if {![info exists arcnos($id)]} return
7751     if {![info exists arcout($id)]} {
7752         recalcarc [lindex $arcnos($id) 0]
7753     }
7754     catch {unset cached_dtags}
7755     catch {unset cached_atags}
7756 }
7757
7758 proc addedhead {hid head} {
7759     global arcnos arcout cached_dheads
7760
7761     if {![info exists arcnos($hid)]} return
7762     if {![info exists arcout($hid)]} {
7763         recalcarc [lindex $arcnos($hid) 0]
7764     }
7765     catch {unset cached_dheads}
7766 }
7767
7768 proc removedhead {hid head} {
7769     global cached_dheads
7770
7771     catch {unset cached_dheads}
7772 }
7773
7774 proc movedhead {hid head} {
7775     global arcnos arcout cached_dheads
7776
7777     if {![info exists arcnos($hid)]} return
7778     if {![info exists arcout($hid)]} {
7779         recalcarc [lindex $arcnos($hid) 0]
7780     }
7781     catch {unset cached_dheads}
7782 }
7783
7784 proc changedrefs {} {
7785     global cached_dheads cached_dtags cached_atags
7786     global arctags archeads arcnos arcout idheads idtags
7787
7788     foreach id [concat [array names idheads] [array names idtags]] {
7789         if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
7790             set a [lindex $arcnos($id) 0]
7791             if {![info exists donearc($a)]} {
7792                 recalcarc $a
7793                 set donearc($a) 1
7794             }
7795         }
7796     }
7797     catch {unset cached_dtags}
7798     catch {unset cached_atags}
7799     catch {unset cached_dheads}
7800 }
7801
7802 proc rereadrefs {} {
7803     global idtags idheads idotherrefs mainhead
7804
7805     set refids [concat [array names idtags] \
7806                     [array names idheads] [array names idotherrefs]]
7807     foreach id $refids {
7808         if {![info exists ref($id)]} {
7809             set ref($id) [listrefs $id]
7810         }
7811     }
7812     set oldmainhead $mainhead
7813     readrefs
7814     changedrefs
7815     set refids [lsort -unique [concat $refids [array names idtags] \
7816                         [array names idheads] [array names idotherrefs]]]
7817     foreach id $refids {
7818         set v [listrefs $id]
7819         if {![info exists ref($id)] || $ref($id) != $v ||
7820             ($id eq $oldmainhead && $id ne $mainhead) ||
7821             ($id eq $mainhead && $id ne $oldmainhead)} {
7822             redrawtags $id
7823         }
7824     }
7825     run refill_reflist
7826 }
7827
7828 proc listrefs {id} {
7829     global idtags idheads idotherrefs
7830
7831     set x {}
7832     if {[info exists idtags($id)]} {
7833         set x $idtags($id)
7834     }
7835     set y {}
7836     if {[info exists idheads($id)]} {
7837         set y $idheads($id)
7838     }
7839     set z {}
7840     if {[info exists idotherrefs($id)]} {
7841         set z $idotherrefs($id)
7842     }
7843     return [list $x $y $z]
7844 }
7845
7846 proc showtag {tag isnew} {
7847     global ctext tagcontents tagids linknum tagobjid
7848
7849     if {$isnew} {
7850         addtohistory [list showtag $tag 0]
7851     }
7852     $ctext conf -state normal
7853     clear_ctext
7854     settabs 0
7855     set linknum 0
7856     if {![info exists tagcontents($tag)]} {
7857         catch {
7858             set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
7859         }
7860     }
7861     if {[info exists tagcontents($tag)]} {
7862         set text $tagcontents($tag)
7863     } else {
7864         set text "Tag: $tag\nId:  $tagids($tag)"
7865     }
7866     appendwithlinks $text {}
7867     $ctext conf -state disabled
7868     init_flist {}
7869 }
7870
7871 proc doquit {} {
7872     global stopped
7873     set stopped 100
7874     savestuff .
7875     destroy .
7876 }
7877
7878 proc doprefs {} {
7879     global maxwidth maxgraphpct diffopts
7880     global oldprefs prefstop showneartags showlocalchanges
7881     global bgcolor fgcolor ctext diffcolors selectbgcolor
7882     global uifont tabstop
7883
7884     set top .gitkprefs
7885     set prefstop $top
7886     if {[winfo exists $top]} {
7887         raise $top
7888         return
7889     }
7890     foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7891         set oldprefs($v) [set $v]
7892     }
7893     toplevel $top
7894     wm title $top "Gitk preferences"
7895     label $top.ldisp -text "Commit list display options"
7896     $top.ldisp configure -font uifont
7897     grid $top.ldisp - -sticky w -pady 10
7898     label $top.spacer -text " "
7899     label $top.maxwidthl -text "Maximum graph width (lines)" \
7900         -font optionfont
7901     spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7902     grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7903     label $top.maxpctl -text "Maximum graph width (% of pane)" \
7904         -font optionfont
7905     spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7906     grid x $top.maxpctl $top.maxpct -sticky w
7907     frame $top.showlocal
7908     label $top.showlocal.l -text "Show local changes" -font optionfont
7909     checkbutton $top.showlocal.b -variable showlocalchanges
7910     pack $top.showlocal.b $top.showlocal.l -side left
7911     grid x $top.showlocal -sticky w
7912
7913     label $top.ddisp -text "Diff display options"
7914     $top.ddisp configure -font uifont
7915     grid $top.ddisp - -sticky w -pady 10
7916     label $top.diffoptl -text "Options for diff program" \
7917         -font optionfont
7918     entry $top.diffopt -width 20 -textvariable diffopts
7919     grid x $top.diffoptl $top.diffopt -sticky w
7920     frame $top.ntag
7921     label $top.ntag.l -text "Display nearby tags" -font optionfont
7922     checkbutton $top.ntag.b -variable showneartags
7923     pack $top.ntag.b $top.ntag.l -side left
7924     grid x $top.ntag -sticky w
7925     label $top.tabstopl -text "tabstop" -font optionfont
7926     spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7927     grid x $top.tabstopl $top.tabstop -sticky w
7928
7929     label $top.cdisp -text "Colors: press to choose"
7930     $top.cdisp configure -font uifont
7931     grid $top.cdisp - -sticky w -pady 10
7932     label $top.bg -padx 40 -relief sunk -background $bgcolor
7933     button $top.bgbut -text "Background" -font optionfont \
7934         -command [list choosecolor bgcolor 0 $top.bg background setbg]
7935     grid x $top.bgbut $top.bg -sticky w
7936     label $top.fg -padx 40 -relief sunk -background $fgcolor
7937     button $top.fgbut -text "Foreground" -font optionfont \
7938         -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
7939     grid x $top.fgbut $top.fg -sticky w
7940     label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
7941     button $top.diffoldbut -text "Diff: old lines" -font optionfont \
7942         -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
7943                       [list $ctext tag conf d0 -foreground]]
7944     grid x $top.diffoldbut $top.diffold -sticky w
7945     label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
7946     button $top.diffnewbut -text "Diff: new lines" -font optionfont \
7947         -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
7948                       [list $ctext tag conf d1 -foreground]]
7949     grid x $top.diffnewbut $top.diffnew -sticky w
7950     label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
7951     button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
7952         -command [list choosecolor diffcolors 2 $top.hunksep \
7953                       "diff hunk header" \
7954                       [list $ctext tag conf hunksep -foreground]]
7955     grid x $top.hunksepbut $top.hunksep -sticky w
7956     label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
7957     button $top.selbgbut -text "Select bg" -font optionfont \
7958         -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
7959     grid x $top.selbgbut $top.selbgsep -sticky w
7960
7961     frame $top.buts
7962     button $top.buts.ok -text "OK" -command prefsok -default active
7963     $top.buts.ok configure -font uifont
7964     button $top.buts.can -text "Cancel" -command prefscan -default normal
7965     $top.buts.can configure -font uifont
7966     grid $top.buts.ok $top.buts.can
7967     grid columnconfigure $top.buts 0 -weight 1 -uniform a
7968     grid columnconfigure $top.buts 1 -weight 1 -uniform a
7969     grid $top.buts - - -pady 10 -sticky ew
7970     bind $top <Visibility> "focus $top.buts.ok"
7971 }
7972
7973 proc choosecolor {v vi w x cmd} {
7974     global $v
7975
7976     set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
7977                -title "Gitk: choose color for $x"]
7978     if {$c eq {}} return
7979     $w conf -background $c
7980     lset $v $vi $c
7981     eval $cmd $c
7982 }
7983
7984 proc setselbg {c} {
7985     global bglist cflist
7986     foreach w $bglist {
7987         $w configure -selectbackground $c
7988     }
7989     $cflist tag configure highlight \
7990         -background [$cflist cget -selectbackground]
7991     allcanvs itemconf secsel -fill $c
7992 }
7993
7994 proc setbg {c} {
7995     global bglist
7996
7997     foreach w $bglist {
7998         $w conf -background $c
7999     }
8000 }
8001
8002 proc setfg {c} {
8003     global fglist canv
8004
8005     foreach w $fglist {
8006         $w conf -foreground $c
8007     }
8008     allcanvs itemconf text -fill $c
8009     $canv itemconf circle -outline $c
8010 }
8011
8012 proc prefscan {} {
8013     global maxwidth maxgraphpct diffopts
8014     global oldprefs prefstop showneartags showlocalchanges
8015
8016     foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
8017         set $v $oldprefs($v)
8018     }
8019     catch {destroy $prefstop}
8020     unset prefstop
8021 }
8022
8023 proc prefsok {} {
8024     global maxwidth maxgraphpct
8025     global oldprefs prefstop showneartags showlocalchanges
8026
8027     catch {destroy $prefstop}
8028     unset prefstop
8029     settabs
8030     if {$showlocalchanges != $oldprefs(showlocalchanges)} {
8031         if {$showlocalchanges} {
8032             doshowlocalchanges
8033         } else {
8034             dohidelocalchanges
8035         }
8036     }
8037     if {$maxwidth != $oldprefs(maxwidth)
8038         || $maxgraphpct != $oldprefs(maxgraphpct)} {
8039         redisplay
8040     } elseif {$showneartags != $oldprefs(showneartags)} {
8041         reselectline
8042     }
8043 }
8044
8045 proc formatdate {d} {
8046     global datetimeformat
8047     if {$d ne {}} {
8048         set d [clock format $d -format $datetimeformat]
8049     }
8050     return $d
8051 }
8052
8053 # This list of encoding names and aliases is distilled from
8054 # http://www.iana.org/assignments/character-sets.
8055 # Not all of them are supported by Tcl.
8056 set encoding_aliases {
8057     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
8058       ISO646-US US-ASCII us IBM367 cp367 csASCII }
8059     { ISO-10646-UTF-1 csISO10646UTF1 }
8060     { ISO_646.basic:1983 ref csISO646basic1983 }
8061     { INVARIANT csINVARIANT }
8062     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
8063     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
8064     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
8065     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
8066     { NATS-DANO iso-ir-9-1 csNATSDANO }
8067     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
8068     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
8069     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
8070     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
8071     { ISO-2022-KR csISO2022KR }
8072     { EUC-KR csEUCKR }
8073     { ISO-2022-JP csISO2022JP }
8074     { ISO-2022-JP-2 csISO2022JP2 }
8075     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
8076       csISO13JISC6220jp }
8077     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
8078     { IT iso-ir-15 ISO646-IT csISO15Italian }
8079     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
8080     { ES iso-ir-17 ISO646-ES csISO17Spanish }
8081     { greek7-old iso-ir-18 csISO18Greek7Old }
8082     { latin-greek iso-ir-19 csISO19LatinGreek }
8083     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
8084     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
8085     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
8086     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
8087     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
8088     { BS_viewdata iso-ir-47 csISO47BSViewdata }
8089     { INIS iso-ir-49 csISO49INIS }
8090     { INIS-8 iso-ir-50 csISO50INIS8 }
8091     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
8092     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
8093     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
8094     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
8095     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
8096     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
8097       csISO60Norwegian1 }
8098     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
8099     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
8100     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
8101     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
8102     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
8103     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
8104     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
8105     { greek7 iso-ir-88 csISO88Greek7 }
8106     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
8107     { iso-ir-90 csISO90 }
8108     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
8109     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
8110       csISO92JISC62991984b }
8111     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
8112     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
8113     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
8114       csISO95JIS62291984handadd }
8115     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
8116     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
8117     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
8118     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
8119       CP819 csISOLatin1 }
8120     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
8121     { T.61-7bit iso-ir-102 csISO102T617bit }
8122     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
8123     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
8124     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
8125     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
8126     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
8127     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
8128     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
8129     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
8130       arabic csISOLatinArabic }
8131     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
8132     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
8133     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
8134       greek greek8 csISOLatinGreek }
8135     { T.101-G2 iso-ir-128 csISO128T101G2 }
8136     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
8137       csISOLatinHebrew }
8138     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
8139     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
8140     { CSN_369103 iso-ir-139 csISO139CSN369103 }
8141     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
8142     { ISO_6937-2-add iso-ir-142 csISOTextComm }
8143     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
8144     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
8145       csISOLatinCyrillic }
8146     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
8147     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
8148     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
8149     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
8150     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
8151     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
8152     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
8153     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
8154     { ISO_10367-box iso-ir-155 csISO10367Box }
8155     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
8156     { latin-lap lap iso-ir-158 csISO158Lap }
8157     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
8158     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
8159     { us-dk csUSDK }
8160     { dk-us csDKUS }
8161     { JIS_X0201 X0201 csHalfWidthKatakana }
8162     { KSC5636 ISO646-KR csKSC5636 }
8163     { ISO-10646-UCS-2 csUnicode }
8164     { ISO-10646-UCS-4 csUCS4 }
8165     { DEC-MCS dec csDECMCS }
8166     { hp-roman8 roman8 r8 csHPRoman8 }
8167     { macintosh mac csMacintosh }
8168     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
8169       csIBM037 }
8170     { IBM038 EBCDIC-INT cp038 csIBM038 }
8171     { IBM273 CP273 csIBM273 }
8172     { IBM274 EBCDIC-BE CP274 csIBM274 }
8173     { IBM275 EBCDIC-BR cp275 csIBM275 }
8174     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
8175     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
8176     { IBM280 CP280 ebcdic-cp-it csIBM280 }
8177     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
8178     { IBM284 CP284 ebcdic-cp-es csIBM284 }
8179     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
8180     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
8181     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
8182     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
8183     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
8184     { IBM424 cp424 ebcdic-cp-he csIBM424 }
8185     { IBM437 cp437 437 csPC8CodePage437 }
8186     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
8187     { IBM775 cp775 csPC775Baltic }
8188     { IBM850 cp850 850 csPC850Multilingual }
8189     { IBM851 cp851 851 csIBM851 }
8190     { IBM852 cp852 852 csPCp852 }
8191     { IBM855 cp855 855 csIBM855 }
8192     { IBM857 cp857 857 csIBM857 }
8193     { IBM860 cp860 860 csIBM860 }
8194     { IBM861 cp861 861 cp-is csIBM861 }
8195     { IBM862 cp862 862 csPC862LatinHebrew }
8196     { IBM863 cp863 863 csIBM863 }
8197     { IBM864 cp864 csIBM864 }
8198     { IBM865 cp865 865 csIBM865 }
8199     { IBM866 cp866 866 csIBM866 }
8200     { IBM868 CP868 cp-ar csIBM868 }
8201     { IBM869 cp869 869 cp-gr csIBM869 }
8202     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
8203     { IBM871 CP871 ebcdic-cp-is csIBM871 }
8204     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
8205     { IBM891 cp891 csIBM891 }
8206     { IBM903 cp903 csIBM903 }
8207     { IBM904 cp904 904 csIBBM904 }
8208     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
8209     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
8210     { IBM1026 CP1026 csIBM1026 }
8211     { EBCDIC-AT-DE csIBMEBCDICATDE }
8212     { EBCDIC-AT-DE-A csEBCDICATDEA }
8213     { EBCDIC-CA-FR csEBCDICCAFR }
8214     { EBCDIC-DK-NO csEBCDICDKNO }
8215     { EBCDIC-DK-NO-A csEBCDICDKNOA }
8216     { EBCDIC-FI-SE csEBCDICFISE }
8217     { EBCDIC-FI-SE-A csEBCDICFISEA }
8218     { EBCDIC-FR csEBCDICFR }
8219     { EBCDIC-IT csEBCDICIT }
8220     { EBCDIC-PT csEBCDICPT }
8221     { EBCDIC-ES csEBCDICES }
8222     { EBCDIC-ES-A csEBCDICESA }
8223     { EBCDIC-ES-S csEBCDICESS }
8224     { EBCDIC-UK csEBCDICUK }
8225     { EBCDIC-US csEBCDICUS }
8226     { UNKNOWN-8BIT csUnknown8BiT }
8227     { MNEMONIC csMnemonic }
8228     { MNEM csMnem }
8229     { VISCII csVISCII }
8230     { VIQR csVIQR }
8231     { KOI8-R csKOI8R }
8232     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
8233     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
8234     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
8235     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
8236     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
8237     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
8238     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
8239     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
8240     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
8241     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
8242     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
8243     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
8244     { IBM1047 IBM-1047 }
8245     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
8246     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
8247     { UNICODE-1-1 csUnicode11 }
8248     { CESU-8 csCESU-8 }
8249     { BOCU-1 csBOCU-1 }
8250     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
8251     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
8252       l8 }
8253     { ISO-8859-15 ISO_8859-15 Latin-9 }
8254     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
8255     { GBK CP936 MS936 windows-936 }
8256     { JIS_Encoding csJISEncoding }
8257     { Shift_JIS MS_Kanji csShiftJIS }
8258     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
8259       EUC-JP }
8260     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
8261     { ISO-10646-UCS-Basic csUnicodeASCII }
8262     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
8263     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
8264     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
8265     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
8266     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
8267     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
8268     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
8269     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
8270     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
8271     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
8272     { Adobe-Standard-Encoding csAdobeStandardEncoding }
8273     { Ventura-US csVenturaUS }
8274     { Ventura-International csVenturaInternational }
8275     { PC8-Danish-Norwegian csPC8DanishNorwegian }
8276     { PC8-Turkish csPC8Turkish }
8277     { IBM-Symbols csIBMSymbols }
8278     { IBM-Thai csIBMThai }
8279     { HP-Legal csHPLegal }
8280     { HP-Pi-font csHPPiFont }
8281     { HP-Math8 csHPMath8 }
8282     { Adobe-Symbol-Encoding csHPPSMath }
8283     { HP-DeskTop csHPDesktop }
8284     { Ventura-Math csVenturaMath }
8285     { Microsoft-Publishing csMicrosoftPublishing }
8286     { Windows-31J csWindows31J }
8287     { GB2312 csGB2312 }
8288     { Big5 csBig5 }
8289 }
8290
8291 proc tcl_encoding {enc} {
8292     global encoding_aliases
8293     set names [encoding names]
8294     set lcnames [string tolower $names]
8295     set enc [string tolower $enc]
8296     set i [lsearch -exact $lcnames $enc]
8297     if {$i < 0} {
8298         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
8299         if {[regsub {^iso[-_]} $enc iso encx]} {
8300             set i [lsearch -exact $lcnames $encx]
8301         }
8302     }
8303     if {$i < 0} {
8304         foreach l $encoding_aliases {
8305             set ll [string tolower $l]
8306             if {[lsearch -exact $ll $enc] < 0} continue
8307             # look through the aliases for one that tcl knows about
8308             foreach e $ll {
8309                 set i [lsearch -exact $lcnames $e]
8310                 if {$i < 0} {
8311                     if {[regsub {^iso[-_]} $e iso ex]} {
8312                         set i [lsearch -exact $lcnames $ex]
8313                     }
8314                 }
8315                 if {$i >= 0} break
8316             }
8317             break
8318         }
8319     }
8320     if {$i >= 0} {
8321         return [lindex $names $i]
8322     }
8323     return {}
8324 }
8325
8326 # defaults...
8327 set datemode 0
8328 set diffopts "-U 5 -p"
8329 set wrcomcmd "git diff-tree --stdin -p --pretty"
8330
8331 set gitencoding {}
8332 catch {
8333     set gitencoding [exec git config --get i18n.commitencoding]
8334 }
8335 if {$gitencoding == ""} {
8336     set gitencoding "utf-8"
8337 }
8338 set tclencoding [tcl_encoding $gitencoding]
8339 if {$tclencoding == {}} {
8340     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
8341 }
8342
8343 set mainfont {Helvetica 9}
8344 set textfont {Courier 9}
8345 set uifont {Helvetica 9 bold}
8346 set tabstop 8
8347 set findmergefiles 0
8348 set maxgraphpct 50
8349 set maxwidth 16
8350 set revlistorder 0
8351 set fastdate 0
8352 set uparrowlen 5
8353 set downarrowlen 5
8354 set mingaplen 100
8355 set cmitmode "patch"
8356 set wrapcomment "none"
8357 set showneartags 1
8358 set maxrefs 20
8359 set maxlinelen 200
8360 set showlocalchanges 1
8361 set datetimeformat "%Y-%m-%d %H:%M:%S"
8362
8363 set colors {green red blue magenta darkgrey brown orange}
8364 set bgcolor white
8365 set fgcolor black
8366 set diffcolors {red "#00a000" blue}
8367 set diffcontext 3
8368 set selectbgcolor gray85
8369
8370 catch {source ~/.gitk}
8371
8372 font create optionfont -family sans-serif -size -12
8373
8374 parsefont mainfont $mainfont
8375 eval font create mainfont [fontflags mainfont]
8376 eval font create mainfontbold [fontflags mainfont 1]
8377
8378 parsefont textfont $textfont
8379 eval font create textfont [fontflags textfont]
8380 eval font create textfontbold [fontflags textfont 1]
8381
8382 parsefont uifont $uifont
8383 eval font create uifont [fontflags uifont]
8384
8385 # check that we can find a .git directory somewhere...
8386 if {[catch {set gitdir [gitdir]}]} {
8387     show_error {} . "Cannot find a git repository here."
8388     exit 1
8389 }
8390 if {![file isdirectory $gitdir]} {
8391     show_error {} . "Cannot find the git directory \"$gitdir\"."
8392     exit 1
8393 }
8394
8395 set revtreeargs {}
8396 set cmdline_files {}
8397 set i 0
8398 foreach arg $argv {
8399     switch -- $arg {
8400         "" { }
8401         "-d" { set datemode 1 }
8402         "--" {
8403             set cmdline_files [lrange $argv [expr {$i + 1}] end]
8404             break
8405         }
8406         default {
8407             lappend revtreeargs $arg
8408         }
8409     }
8410     incr i
8411 }
8412
8413 if {$i >= [llength $argv] && $revtreeargs ne {}} {
8414     # no -- on command line, but some arguments (other than -d)
8415     if {[catch {
8416         set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
8417         set cmdline_files [split $f "\n"]
8418         set n [llength $cmdline_files]
8419         set revtreeargs [lrange $revtreeargs 0 end-$n]
8420         # Unfortunately git rev-parse doesn't produce an error when
8421         # something is both a revision and a filename.  To be consistent
8422         # with git log and git rev-list, check revtreeargs for filenames.
8423         foreach arg $revtreeargs {
8424             if {[file exists $arg]} {
8425                 show_error {} . "Ambiguous argument '$arg': both revision\
8426                                  and filename"
8427                 exit 1
8428             }
8429         }
8430     } err]} {
8431         # unfortunately we get both stdout and stderr in $err,
8432         # so look for "fatal:".
8433         set i [string first "fatal:" $err]
8434         if {$i > 0} {
8435             set err [string range $err [expr {$i + 6}] end]
8436         }
8437         show_error {} . "Bad arguments to gitk:\n$err"
8438         exit 1
8439     }
8440 }
8441
8442 set nullid "0000000000000000000000000000000000000000"
8443 set nullid2 "0000000000000000000000000000000000000001"
8444
8445 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
8446
8447 set runq {}
8448 set history {}
8449 set historyindex 0
8450 set fh_serial 0
8451 set nhl_names {}
8452 set highlight_paths {}
8453 set findpattern {}
8454 set searchdirn -forwards
8455 set boldrows {}
8456 set boldnamerows {}
8457 set diffelide {0 0}
8458 set markingmatches 0
8459 set linkentercount 0
8460 set need_redisplay 0
8461 set nrows_drawn 0
8462 set firsttabstop 0
8463
8464 set nextviewnum 1
8465 set curview 0
8466 set selectedview 0
8467 set selectedhlview None
8468 set highlight_related None
8469 set highlight_files {}
8470 set viewfiles(0) {}
8471 set viewperm(0) 0
8472 set viewargs(0) {}
8473
8474 set cmdlineok 0
8475 set stopped 0
8476 set stuffsaved 0
8477 set patchnum 0
8478 set localirow -1
8479 set localfrow -1
8480 set lserial 0
8481 setcoords
8482 makewindow
8483 # wait for the window to become visible
8484 tkwait visibility .
8485 wm title . "[file tail $argv0]: [file tail [pwd]]"
8486 readrefs
8487
8488 if {$cmdline_files ne {} || $revtreeargs ne {}} {
8489     # create a view for the files/dirs specified on the command line
8490     set curview 1
8491     set selectedview 1
8492     set nextviewnum 2
8493     set viewname(1) "Command line"
8494     set viewfiles(1) $cmdline_files
8495     set viewargs(1) $revtreeargs
8496     set viewperm(1) 0
8497     addviewmenu 1
8498     .bar.view entryconf Edit* -state normal
8499     .bar.view entryconf Delete* -state normal
8500 }
8501
8502 if {[info exists permviews]} {
8503     foreach v $permviews {
8504         set n $nextviewnum
8505         incr nextviewnum
8506         set viewname($n) [lindex $v 0]
8507         set viewfiles($n) [lindex $v 1]
8508         set viewargs($n) [lindex $v 2]
8509         set viewperm($n) 1
8510         addviewmenu $n
8511     }
8512 }
8513 getcommits