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