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