gitk

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