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