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