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 ctext entries
 968     foreach e [concat $entries $ctext] {
 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             set idinlist($p) 1
2884         }
2885         set nev [expr {[llength $idlist] + [llength $newolds]
2886                        + [llength $oldolds] - $maxwidth + 1}]
2887         if {$nev > 0} {
2888             if {!$last &&
2889                 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2890             for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2891                 set i [lindex $idlist $x]
2892                 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2893                     set r [usedinrange $i [expr {$row - $downarrowlen}] \
2894                                [expr {$row + $uparrowlen + $mingaplen}]]
2895                     if {$r == 0} {
2896                         set idlist [lreplace $idlist $x $x]
2897                         set offs [lreplace $offs $x $x]
2898                         set offs [incrange $offs $x 1]
2899                         set idinlist($i) 0
2900                         set rm1 [expr {$row - 1}]
2901                         lappend idrowranges($i) [lindex $displayorder $rm1]
2902                         if {[incr nev -1] <= 0} break
2903                         continue
2904                     }
2905                     set rowchk($id) [expr {$row + $r}]
2906                 }
2907             }
2908             lset rowidlist $row $idlist
2909             lset rowoffsets $row $offs
2910         }
2911         set col [lsearch -exact $idlist $id]
2912         if {$col < 0} {
2913             set col [llength $idlist]
2914             lappend idlist $id
2915             lset rowidlist $row $idlist
2916             set z {}
2917             if {$children($curview,$id) ne {}} {
2918                 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2919                 unset idinlist($id)
2920             }
2921             lappend offs $z
2922             lset rowoffsets $row $offs
2923             if {$z ne {}} {
2924                 makeuparrow $id $col $row $z
2925             }
2926         } else {
2927             unset idinlist($id)
2928         }
2929         set ranges {}
2930         if {[info exists idrowranges($id)]} {
2931             set ranges $idrowranges($id)
2932             lappend ranges $id
2933             unset idrowranges($id)
2934         }
2935         lappend rowrangelist $ranges
2936         incr row
2937         set offs [ntimes [llength $idlist] 0]
2938         set l [llength $newolds]
2939         set idlist [eval lreplace \$idlist $col $col $newolds]
2940         set o 0
2941         if {$l != 1} {
2942             set offs [lrange $offs 0 [expr {$col - 1}]]
2943             foreach x $newolds {
2944                 lappend offs {}
2945                 incr o -1
2946             }
2947             incr o
2948             set tmp [expr {[llength $idlist] - [llength $offs]}]
2949             if {$tmp > 0} {
2950                 set offs [concat $offs [ntimes $tmp $o]]
2951             }
2952         } else {
2953             lset offs $col {}
2954         }
2955         foreach i $newolds {
2956             set idrowranges($i) $id
2957         }
2958         incr col $l
2959         foreach oid $oldolds {
2960             set idlist [linsert $idlist $col $oid]
2961             set offs [linsert $offs $col $o]
2962             makeuparrow $oid $col $row $o
2963             incr col
2964         }
2965         lappend rowidlist $idlist
2966         lappend rowoffsets $offs
2967     }
2968     return $row
2969 }
2970
2971 proc addextraid {id row} {
2972     global displayorder commitrow commitinfo
2973     global commitidx commitlisted
2974     global parentlist children curview
2975
2976     incr commitidx($curview)
2977     lappend displayorder $id
2978     lappend commitlisted 0
2979     lappend parentlist {}
2980     set commitrow($curview,$id) $row
2981     readcommit $id
2982     if {![info exists commitinfo($id)]} {
2983         set commitinfo($id) {"No commit information available"}
2984     }
2985     if {![info exists children($curview,$id)]} {
2986         set children($curview,$id) {}
2987     }
2988 }
2989
2990 proc layouttail {} {
2991     global rowidlist rowoffsets idinlist commitidx curview
2992     global idrowranges rowrangelist
2993
2994     set row $commitidx($curview)
2995     set idlist [lindex $rowidlist $row]
2996     while {$idlist ne {}} {
2997         set col [expr {[llength $idlist] - 1}]
2998         set id [lindex $idlist $col]
2999         addextraid $id $row
3000         catch {unset idinlist($id)}
3001         lappend idrowranges($id) $id
3002         lappend rowrangelist $idrowranges($id)
3003         unset idrowranges($id)
3004         incr row
3005         set offs [ntimes $col 0]
3006         set idlist [lreplace $idlist $col $col]
3007         lappend rowidlist $idlist
3008         lappend rowoffsets $offs
3009     }
3010
3011     foreach id [array names idinlist] {
3012         unset idinlist($id)
3013         addextraid $id $row
3014         lset rowidlist $row [list $id]
3015         lset rowoffsets $row 0
3016         makeuparrow $id 0 $row 0
3017         lappend idrowranges($id) $id
3018         lappend rowrangelist $idrowranges($id)
3019         unset idrowranges($id)
3020         incr row
3021         lappend rowidlist {}
3022         lappend rowoffsets {}
3023     }
3024 }
3025
3026 proc insert_pad {row col npad} {
3027     global rowidlist rowoffsets
3028
3029     set pad [ntimes $npad {}]
3030     lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
3031     set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
3032     lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
3033 }
3034
3035 proc optimize_rows {row col endrow} {
3036     global rowidlist rowoffsets displayorder
3037
3038     for {} {$row < $endrow} {incr row} {
3039         set idlist [lindex $rowidlist $row]
3040         set offs [lindex $rowoffsets $row]
3041         set haspad 0
3042         for {} {$col < [llength $offs]} {incr col} {
3043             if {[lindex $idlist $col] eq {}} {
3044                 set haspad 1
3045                 continue
3046             }
3047             set z [lindex $offs $col]
3048             if {$z eq {}} continue
3049             set isarrow 0
3050             set x0 [expr {$col + $z}]
3051             set y0 [expr {$row - 1}]
3052             set z0 [lindex $rowoffsets $y0 $x0]
3053             if {$z0 eq {}} {
3054                 set id [lindex $idlist $col]
3055                 set ranges [rowranges $id]
3056                 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
3057                     set isarrow 1
3058                 }
3059             }
3060             # Looking at lines from this row to the previous row,
3061             # make them go straight up if they end in an arrow on
3062             # the previous row; otherwise make them go straight up
3063             # or at 45 degrees.
3064             if {$z < -1 || ($z < 0 && $isarrow)} {
3065                 # Line currently goes left too much;
3066                 # insert pads in the previous row, then optimize it
3067                 set npad [expr {-1 - $z + $isarrow}]
3068                 set offs [incrange $offs $col $npad]
3069                 insert_pad $y0 $x0 $npad
3070                 if {$y0 > 0} {
3071                     optimize_rows $y0 $x0 $row
3072                 }
3073                 set z [lindex $offs $col]
3074                 set x0 [expr {$col + $z}]
3075                 set z0 [lindex $rowoffsets $y0 $x0]
3076             } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3077                 # Line currently goes right too much;
3078                 # insert pads in this line and adjust the next's rowoffsets
3079                 set npad [expr {$z - 1 + $isarrow}]
3080                 set y1 [expr {$row + 1}]
3081                 set offs2 [lindex $rowoffsets $y1]
3082                 set x1 -1
3083                 foreach z $offs2 {
3084                     incr x1
3085                     if {$z eq {} || $x1 + $z < $col} continue
3086                     if {$x1 + $z > $col} {
3087                         incr npad
3088                     }
3089                     lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
3090                     break
3091                 }
3092                 set pad [ntimes $npad {}]
3093                 set idlist [eval linsert \$idlist $col $pad]
3094                 set tmp [eval linsert \$offs $col $pad]
3095                 incr col $npad
3096                 set offs [incrange $tmp $col [expr {-$npad}]]
3097                 set z [lindex $offs $col]
3098                 set haspad 1
3099             }
3100             if {$z0 eq {} && !$isarrow} {
3101                 # this line links to its first child on row $row-2
3102                 set rm2 [expr {$row - 2}]
3103                 set id [lindex $displayorder $rm2]
3104                 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
3105                 if {$xc >= 0} {
3106                     set z0 [expr {$xc - $x0}]
3107                 }
3108             }
3109             # avoid lines jigging left then immediately right
3110             if {$z0 ne {} && $z < 0 && $z0 > 0} {
3111                 insert_pad $y0 $x0 1
3112                 set offs [incrange $offs $col 1]
3113                 optimize_rows $y0 [expr {$x0 + 1}] $row
3114             }
3115         }
3116         if {!$haspad} {
3117             set o {}
3118             # Find the first column that doesn't have a line going right
3119             for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3120                 set o [lindex $offs $col]
3121                 if {$o eq {}} {
3122                     # check if this is the link to the first child
3123                     set id [lindex $idlist $col]
3124                     set ranges [rowranges $id]
3125                     if {$ranges ne {} && $row == [lindex $ranges 0]} {
3126                         # it is, work out offset to child
3127                         set y0 [expr {$row - 1}]
3128                         set id [lindex $displayorder $y0]
3129                         set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
3130                         if {$x0 >= 0} {
3131                             set o [expr {$x0 - $col}]
3132                         }
3133                     }
3134                 }
3135                 if {$o eq {} || $o <= 0} break
3136             }
3137             # Insert a pad at that column as long as it has a line and
3138             # isn't the last column, and adjust the next row' offsets
3139             if {$o ne {} && [incr col] < [llength $idlist]} {
3140                 set y1 [expr {$row + 1}]
3141                 set offs2 [lindex $rowoffsets $y1]
3142                 set x1 -1
3143                 foreach z $offs2 {
3144                     incr x1
3145                     if {$z eq {} || $x1 + $z < $col} continue
3146                     lset rowoffsets $y1 [incrange $offs2 $x1 1]
3147                     break
3148                 }
3149                 set idlist [linsert $idlist $col {}]
3150                 set tmp [linsert $offs $col {}]
3151                 incr col
3152                 set offs [incrange $tmp $col -1]
3153             }
3154         }
3155         lset rowidlist $row $idlist
3156         lset rowoffsets $row $offs
3157         set col 0
3158     }
3159 }
3160
3161 proc xc {row col} {
3162     global canvx0 linespc
3163     return [expr {$canvx0 + $col * $linespc}]
3164 }
3165
3166 proc yc {row} {
3167     global canvy0 linespc
3168     return [expr {$canvy0 + $row * $linespc}]
3169 }
3170
3171 proc linewidth {id} {
3172     global thickerline lthickness
3173
3174     set wid $lthickness
3175     if {[info exists thickerline] && $id eq $thickerline} {
3176         set wid [expr {2 * $lthickness}]
3177     }
3178     return $wid
3179 }
3180
3181 proc rowranges {id} {
3182     global phase idrowranges commitrow rowlaidout rowrangelist curview
3183
3184     set ranges {}
3185     if {$phase eq {} ||
3186         ([info exists commitrow($curview,$id)]
3187          && $commitrow($curview,$id) < $rowlaidout)} {
3188         set ranges [lindex $rowrangelist $commitrow($curview,$id)]
3189     } elseif {[info exists idrowranges($id)]} {
3190         set ranges $idrowranges($id)
3191     }
3192     set linenos {}
3193     foreach rid $ranges {
3194         lappend linenos $commitrow($curview,$rid)
3195     }
3196     if {$linenos ne {}} {
3197         lset linenos 0 [expr {[lindex $linenos 0] + 1}]
3198     }
3199     return $linenos
3200 }
3201
3202 # work around tk8.4 refusal to draw arrows on diagonal segments
3203 proc adjarrowhigh {coords} {
3204     global linespc
3205
3206     set x0 [lindex $coords 0]
3207     set x1 [lindex $coords 2]
3208     if {$x0 != $x1} {
3209         set y0 [lindex $coords 1]
3210         set y1 [lindex $coords 3]
3211         if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
3212             # we have a nearby vertical segment, just trim off the diag bit
3213             set coords [lrange $coords 2 end]
3214         } else {
3215             set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
3216             set xi [expr {$x0 - $slope * $linespc / 2}]
3217             set yi [expr {$y0 - $linespc / 2}]
3218             set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
3219         }
3220     }
3221     return $coords
3222 }
3223
3224 proc drawlineseg {id row endrow arrowlow} {
3225     global rowidlist displayorder iddrawn linesegs
3226     global canv colormap linespc curview maxlinelen
3227
3228     set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3229     set le [expr {$row + 1}]
3230     set arrowhigh 1
3231     while {1} {
3232         set c [lsearch -exact [lindex $rowidlist $le] $id]
3233         if {$c < 0} {
3234             incr le -1
3235             break
3236         }
3237         lappend cols $c
3238         set x [lindex $displayorder $le]
3239         if {$x eq $id} {
3240             set arrowhigh 0
3241             break
3242         }
3243         if {[info exists iddrawn($x)] || $le == $endrow} {
3244             set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3245             if {$c >= 0} {
3246                 lappend cols $c
3247                 set arrowhigh 0
3248             }
3249             break
3250         }
3251         incr le
3252     }
3253     if {$le <= $row} {
3254         return $row
3255     }
3256
3257     set lines {}
3258     set i 0
3259     set joinhigh 0
3260     if {[info exists linesegs($id)]} {
3261         set lines $linesegs($id)
3262         foreach li $lines {
3263             set r0 [lindex $li 0]
3264             if {$r0 > $row} {
3265                 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3266                     set joinhigh 1
3267                 }
3268                 break
3269             }
3270             incr i
3271         }
3272     }
3273     set joinlow 0
3274     if {$i > 0} {
3275         set li [lindex $lines [expr {$i-1}]]
3276         set r1 [lindex $li 1]
3277         if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3278             set joinlow 1
3279         }
3280     }
3281
3282     set x [lindex $cols [expr {$le - $row}]]
3283     set xp [lindex $cols [expr {$le - 1 - $row}]]
3284     set dir [expr {$xp - $x}]
3285     if {$joinhigh} {
3286         set ith [lindex $lines $i 2]
3287         set coords [$canv coords $ith]
3288         set ah [$canv itemcget $ith -arrow]
3289         set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3290         set x2 [lindex $cols [expr {$le + 1 - $row}]]
3291         if {$x2 ne {} && $x - $x2 == $dir} {
3292             set coords [lrange $coords 0 end-2]
3293         }
3294     } else {
3295         set coords [list [xc $le $x] [yc $le]]
3296     }
3297     if {$joinlow} {
3298         set itl [lindex $lines [expr {$i-1}] 2]
3299         set al [$canv itemcget $itl -arrow]
3300         set arrowlow [expr {$al eq "last" || $al eq "both"}]
3301     } elseif {$arrowlow &&
3302               [lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0} {
3303         set arrowlow 0
3304     }
3305     set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3306     for {set y $le} {[incr y -1] > $row} {} {
3307         set x $xp
3308         set xp [lindex $cols [expr {$y - 1 - $row}]]
3309         set ndir [expr {$xp - $x}]
3310         if {$dir != $ndir || $xp < 0} {
3311             lappend coords [xc $y $x] [yc $y]
3312         }
3313         set dir $ndir
3314     }
3315     if {!$joinlow} {
3316         if {$xp < 0} {
3317             # join parent line to first child
3318             set ch [lindex $displayorder $row]
3319             set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3320             if {$xc < 0} {
3321                 puts "oops: drawlineseg: child $ch not on row $row"
3322             } else {
3323                 if {$xc < $x - 1} {
3324                     lappend coords [xc $row [expr {$x-1}]] [yc $row]
3325                 } elseif {$xc > $x + 1} {
3326                     lappend coords [xc $row [expr {$x+1}]] [yc $row]
3327                 }
3328                 set x $xc
3329             }
3330             lappend coords [xc $row $x] [yc $row]
3331         } else {
3332             set xn [xc $row $xp]
3333             set yn [yc $row]
3334             # work around tk8.4 refusal to draw arrows on diagonal segments
3335             if {$arrowlow && $xn != [lindex $coords end-1]} {
3336                 if {[llength $coords] < 4 ||
3337                     [lindex $coords end-3] != [lindex $coords end-1] ||
3338                     [lindex $coords end] - $yn > 2 * $linespc} {
3339                     set xn [xc $row [expr {$xp - 0.5 * $dir}]]
3340                     set yo [yc [expr {$row + 0.5}]]
3341                     lappend coords $xn $yo $xn $yn
3342                 }
3343             } else {
3344                 lappend coords $xn $yn
3345             }
3346         }
3347         if {!$joinhigh} {
3348             if {$arrowhigh} {
3349                 set coords [adjarrowhigh $coords]
3350             }
3351             assigncolor $id
3352             set t [$canv create line $coords -width [linewidth $id] \
3353                        -fill $colormap($id) -tags lines.$id -arrow $arrow]
3354             $canv lower $t
3355             bindline $t $id
3356             set lines [linsert $lines $i [list $row $le $t]]
3357         } else {
3358             $canv coords $ith $coords
3359             if {$arrow ne $ah} {
3360                 $canv itemconf $ith -arrow $arrow
3361             }
3362             lset lines $i 0 $row
3363         }
3364     } else {
3365         set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3366         set ndir [expr {$xo - $xp}]
3367         set clow [$canv coords $itl]
3368         if {$dir == $ndir} {
3369             set clow [lrange $clow 2 end]
3370         }
3371         set coords [concat $coords $clow]
3372         if {!$joinhigh} {
3373             lset lines [expr {$i-1}] 1 $le
3374             if {$arrowhigh} {
3375                 set coords [adjarrowhigh $coords]
3376             }
3377         } else {
3378             # coalesce two pieces
3379             $canv delete $ith
3380             set b [lindex $lines [expr {$i-1}] 0]
3381             set e [lindex $lines $i 1]
3382             set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3383         }
3384         $canv coords $itl $coords
3385         if {$arrow ne $al} {
3386             $canv itemconf $itl -arrow $arrow
3387         }
3388     }
3389
3390     set linesegs($id) $lines
3391     return $le
3392 }
3393
3394 proc drawparentlinks {id row} {
3395     global rowidlist canv colormap curview parentlist
3396     global idpos
3397
3398     set rowids [lindex $rowidlist $row]
3399     set col [lsearch -exact $rowids $id]
3400     if {$col < 0} return
3401     set olds [lindex $parentlist $row]
3402     set row2 [expr {$row + 1}]
3403     set x [xc $row $col]
3404     set y [yc $row]
3405     set y2 [yc $row2]
3406     set ids [lindex $rowidlist $row2]
3407     # rmx = right-most X coord used
3408     set rmx 0
3409     foreach p $olds {
3410         set i [lsearch -exact $ids $p]
3411         if {$i < 0} {
3412             puts "oops, parent $p of $id not in list"
3413             continue
3414         }
3415         set x2 [xc $row2 $i]
3416         if {$x2 > $rmx} {
3417             set rmx $x2
3418         }
3419         if {[lsearch -exact $rowids $p] < 0} {
3420             # drawlineseg will do this one for us
3421             continue
3422         }
3423         assigncolor $p
3424         # should handle duplicated parents here...
3425         set coords [list $x $y]
3426         if {$i < $col - 1} {
3427             lappend coords [xc $row [expr {$i + 1}]] $y
3428         } elseif {$i > $col + 1} {
3429             lappend coords [xc $row [expr {$i - 1}]] $y
3430         }
3431         lappend coords $x2 $y2
3432         set t [$canv create line $coords -width [linewidth $p] \
3433                    -fill $colormap($p) -tags lines.$p]
3434         $canv lower $t
3435         bindline $t $p
3436     }
3437     if {$rmx > [lindex $idpos($id) 1]} {
3438         lset idpos($id) 1 $rmx
3439         redrawtags $id
3440     }
3441 }
3442
3443 proc drawlines {id} {
3444     global canv
3445
3446     $canv itemconf lines.$id -width [linewidth $id]
3447 }
3448
3449 proc drawcmittext {id row col} {
3450     global linespc canv canv2 canv3 canvy0 fgcolor curview
3451     global commitlisted commitinfo rowidlist parentlist
3452     global rowtextx idpos idtags idheads idotherrefs
3453     global linehtag linentag linedtag
3454     global mainfont canvxmax boldrows boldnamerows fgcolor nullid nullid2
3455
3456     # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
3457     set listed [lindex $commitlisted $row]
3458     if {$id eq $nullid} {
3459         set ofill red
3460     } elseif {$id eq $nullid2} {
3461         set ofill green
3462     } else {
3463         set ofill [expr {$listed != 0? "blue": "white"}]
3464     }
3465     set x [xc $row $col]
3466     set y [yc $row]
3467     set orad [expr {$linespc / 3}]
3468     if {$listed <= 1} {
3469         set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3470                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3471                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
3472     } elseif {$listed == 2} {
3473         # triangle pointing left for left-side commits
3474         set t [$canv create polygon \
3475                    [expr {$x - $orad}] $y \
3476                    [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3477                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3478                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
3479     } else {
3480         # triangle pointing right for right-side commits
3481         set t [$canv create polygon \
3482                    [expr {$x + $orad - 1}] $y \
3483                    [expr {$x - $orad}] [expr {$y - $orad}] \
3484                    [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3485                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
3486     }
3487     $canv raise $t
3488     $canv bind $t <1> {selcanvline {} %x %y}
3489     set rmx [llength [lindex $rowidlist $row]]
3490     set olds [lindex $parentlist $row]
3491     if {$olds ne {}} {
3492         set nextids [lindex $rowidlist [expr {$row + 1}]]
3493         foreach p $olds {
3494             set i [lsearch -exact $nextids $p]
3495             if {$i > $rmx} {
3496                 set rmx $i
3497             }
3498         }
3499     }
3500     set xt [xc $row $rmx]
3501     set rowtextx($row) $xt
3502     set idpos($id) [list $x $xt $y]
3503     if {[info exists idtags($id)] || [info exists idheads($id)]
3504         || [info exists idotherrefs($id)]} {
3505         set xt [drawtags $id $x $xt $y]
3506     }
3507     set headline [lindex $commitinfo($id) 0]
3508     set name [lindex $commitinfo($id) 1]
3509     set date [lindex $commitinfo($id) 2]
3510     set date [formatdate $date]
3511     set font $mainfont
3512     set nfont $mainfont
3513     set isbold [ishighlighted $row]
3514     if {$isbold > 0} {
3515         lappend boldrows $row
3516         lappend font bold
3517         if {$isbold > 1} {
3518             lappend boldnamerows $row
3519             lappend nfont bold
3520         }
3521     }
3522     set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3523                             -text $headline -font $font -tags text]
3524     $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3525     set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3526                             -text $name -font $nfont -tags text]
3527     set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3528                             -text $date -font $mainfont -tags text]
3529     set xr [expr {$xt + [font measure $mainfont $headline]}]
3530     if {$xr > $canvxmax} {
3531         set canvxmax $xr
3532         setcanvscroll
3533     }
3534 }
3535
3536 proc drawcmitrow {row} {
3537     global displayorder rowidlist
3538     global iddrawn markingmatches
3539     global commitinfo parentlist numcommits
3540     global filehighlight fhighlights findstring nhighlights
3541     global hlview vhighlights
3542     global highlight_related rhighlights
3543
3544     if {$row >= $numcommits} return
3545
3546     set id [lindex $displayorder $row]
3547     if {[info exists hlview] && ![info exists vhighlights($row)]} {
3548         askvhighlight $row $id
3549     }
3550     if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3551         askfilehighlight $row $id
3552     }
3553     if {$findstring ne {} && ![info exists nhighlights($row)]} {
3554         askfindhighlight $row $id
3555     }
3556     if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3557         askrelhighlight $row $id
3558     }
3559     if {![info exists iddrawn($id)]} {
3560         set col [lsearch -exact [lindex $rowidlist $row] $id]
3561         if {$col < 0} {
3562             puts "oops, row $row id $id not in list"
3563             return
3564         }
3565         if {![info exists commitinfo($id)]} {
3566             getcommit $id
3567         }
3568         assigncolor $id
3569         drawcmittext $id $row $col
3570         set iddrawn($id) 1
3571     }
3572     if {$markingmatches} {
3573         markrowmatches $row $id
3574     }
3575 }
3576
3577 proc drawcommits {row {endrow {}}} {
3578     global numcommits iddrawn displayorder curview
3579     global parentlist rowidlist
3580
3581     if {$row < 0} {
3582         set row 0
3583     }
3584     if {$endrow eq {}} {
3585         set endrow $row
3586     }
3587     if {$endrow >= $numcommits} {
3588         set endrow [expr {$numcommits - 1}]
3589     }
3590
3591     # make the lines join to already-drawn rows either side
3592     set r [expr {$row - 1}]
3593     if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3594         set r $row
3595     }
3596     set er [expr {$endrow + 1}]
3597     if {$er >= $numcommits ||
3598         ![info exists iddrawn([lindex $displayorder $er])]} {
3599         set er $endrow
3600     }
3601     for {} {$r <= $er} {incr r} {
3602         set id [lindex $displayorder $r]
3603         set wasdrawn [info exists iddrawn($id)]
3604         drawcmitrow $r
3605         if {$r == $er} break
3606         set nextid [lindex $displayorder [expr {$r + 1}]]
3607         if {$wasdrawn && [info exists iddrawn($nextid)]} {
3608             catch {unset prevlines}
3609             continue
3610         }
3611         drawparentlinks $id $r
3612
3613         if {[info exists lineends($r)]} {
3614             foreach lid $lineends($r) {
3615                 unset prevlines($lid)
3616             }
3617         }
3618         set rowids [lindex $rowidlist $r]
3619         foreach lid $rowids {
3620             if {$lid eq {}} continue
3621             if {$lid eq $id} {
3622                 # see if this is the first child of any of its parents
3623                 foreach p [lindex $parentlist $r] {
3624                     if {[lsearch -exact $rowids $p] < 0} {
3625                         # make this line extend up to the child
3626                         set le [drawlineseg $p $r $er 0]
3627                         lappend lineends($le) $p
3628                         set prevlines($p) 1
3629                     }
3630                 }
3631             } elseif {![info exists prevlines($lid)]} {
3632                 set le [drawlineseg $lid $r $er 1]
3633                 lappend lineends($le) $lid
3634                 set prevlines($lid) 1
3635             }
3636         }
3637     }
3638 }
3639
3640 proc drawfrac {f0 f1} {
3641     global canv linespc
3642
3643     set ymax [lindex [$canv cget -scrollregion] 3]
3644     if {$ymax eq {} || $ymax == 0} return
3645     set y0 [expr {int($f0 * $ymax)}]
3646     set row [expr {int(($y0 - 3) / $linespc) - 1}]
3647     set y1 [expr {int($f1 * $ymax)}]
3648     set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3649     drawcommits $row $endrow
3650 }
3651
3652 proc drawvisible {} {
3653     global canv
3654     eval drawfrac [$canv yview]
3655 }
3656
3657 proc clear_display {} {
3658     global iddrawn linesegs
3659     global vhighlights fhighlights nhighlights rhighlights
3660
3661     allcanvs delete all
3662     catch {unset iddrawn}
3663     catch {unset linesegs}
3664     catch {unset vhighlights}
3665     catch {unset fhighlights}
3666     catch {unset nhighlights}
3667     catch {unset rhighlights}
3668 }
3669
3670 proc findcrossings {id} {
3671     global rowidlist parentlist numcommits rowoffsets displayorder
3672
3673     set cross {}
3674     set ccross {}
3675     foreach {s e} [rowranges $id] {
3676         if {$e >= $numcommits} {
3677             set e [expr {$numcommits - 1}]
3678         }
3679         if {$e <= $s} continue
3680         set x [lsearch -exact [lindex $rowidlist $e] $id]
3681         if {$x < 0} {
3682             puts "findcrossings: oops, no [shortids $id] in row $e"
3683             continue
3684         }
3685         for {set row $e} {[incr row -1] >= $s} {} {
3686             set olds [lindex $parentlist $row]
3687             set kid [lindex $displayorder $row]
3688             set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3689             if {$kidx < 0} continue
3690             set nextrow [lindex $rowidlist [expr {$row + 1}]]
3691             foreach p $olds {
3692                 set px [lsearch -exact $nextrow $p]
3693                 if {$px < 0} continue
3694                 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3695                     if {[lsearch -exact $ccross $p] >= 0} continue
3696                     if {$x == $px + ($kidx < $px? -1: 1)} {
3697                         lappend ccross $p
3698                     } elseif {[lsearch -exact $cross $p] < 0} {
3699                         lappend cross $p
3700                     }
3701                 }
3702             }
3703             set inc [lindex $rowoffsets $row $x]
3704             if {$inc eq {}} break
3705             incr x $inc
3706         }
3707     }
3708     return [concat $ccross {{}} $cross]
3709 }
3710
3711 proc assigncolor {id} {
3712     global colormap colors nextcolor
3713     global commitrow parentlist children children curview
3714
3715     if {[info exists colormap($id)]} return
3716     set ncolors [llength $colors]
3717     if {[info exists children($curview,$id)]} {
3718         set kids $children($curview,$id)
3719     } else {
3720         set kids {}
3721     }
3722     if {[llength $kids] == 1} {
3723         set child [lindex $kids 0]
3724         if {[info exists colormap($child)]
3725             && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3726             set colormap($id) $colormap($child)
3727             return
3728         }
3729     }
3730     set badcolors {}
3731     set origbad {}
3732     foreach x [findcrossings $id] {
3733         if {$x eq {}} {
3734             # delimiter between corner crossings and other crossings
3735             if {[llength $badcolors] >= $ncolors - 1} break
3736             set origbad $badcolors
3737         }
3738         if {[info exists colormap($x)]
3739             && [lsearch -exact $badcolors $colormap($x)] < 0} {
3740             lappend badcolors $colormap($x)
3741         }
3742     }
3743     if {[llength $badcolors] >= $ncolors} {
3744         set badcolors $origbad
3745     }
3746     set origbad $badcolors
3747     if {[llength $badcolors] < $ncolors - 1} {
3748         foreach child $kids {
3749             if {[info exists colormap($child)]
3750                 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3751                 lappend badcolors $colormap($child)
3752             }
3753             foreach p [lindex $parentlist $commitrow($curview,$child)] {
3754                 if {[info exists colormap($p)]
3755                     && [lsearch -exact $badcolors $colormap($p)] < 0} {
3756                     lappend badcolors $colormap($p)
3757                 }
3758             }
3759         }
3760         if {[llength $badcolors] >= $ncolors} {
3761             set badcolors $origbad
3762         }
3763     }
3764     for {set i 0} {$i <= $ncolors} {incr i} {
3765         set c [lindex $colors $nextcolor]
3766         if {[incr nextcolor] >= $ncolors} {
3767             set nextcolor 0
3768         }
3769         if {[lsearch -exact $badcolors $c]} break
3770     }
3771     set colormap($id) $c
3772 }
3773
3774 proc bindline {t id} {
3775     global canv
3776
3777     $canv bind $t <Enter> "lineenter %x %y $id"
3778     $canv bind $t <Motion> "linemotion %x %y $id"
3779     $canv bind $t <Leave> "lineleave $id"
3780     $canv bind $t <Button-1> "lineclick %x %y $id 1"
3781 }
3782
3783 proc drawtags {id x xt y1} {
3784     global idtags idheads idotherrefs mainhead
3785     global linespc lthickness
3786     global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3787
3788     set marks {}
3789     set ntags 0
3790     set nheads 0
3791     if {[info exists idtags($id)]} {
3792         set marks $idtags($id)
3793         set ntags [llength $marks]
3794     }
3795     if {[info exists idheads($id)]} {
3796         set marks [concat $marks $idheads($id)]
3797         set nheads [llength $idheads($id)]
3798     }
3799     if {[info exists idotherrefs($id)]} {
3800         set marks [concat $marks $idotherrefs($id)]
3801     }
3802     if {$marks eq {}} {
3803         return $xt
3804     }
3805
3806     set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3807     set yt [expr {$y1 - 0.5 * $linespc}]
3808     set yb [expr {$yt + $linespc - 1}]
3809     set xvals {}
3810     set wvals {}
3811     set i -1
3812     foreach tag $marks {
3813         incr i
3814         if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3815             set wid [font measure [concat $mainfont bold] $tag]
3816         } else {
3817             set wid [font measure $mainfont $tag]
3818         }
3819         lappend xvals $xt
3820         lappend wvals $wid
3821         set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3822     }
3823     set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3824                -width $lthickness -fill black -tags tag.$id]
3825     $canv lower $t
3826     foreach tag $marks x $xvals wid $wvals {
3827         set xl [expr {$x + $delta}]
3828         set xr [expr {$x + $delta + $wid + $lthickness}]
3829         set font $mainfont
3830         if {[incr ntags -1] >= 0} {
3831             # draw a tag
3832             set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3833                        $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3834                        -width 1 -outline black -fill yellow -tags tag.$id]
3835             $canv bind $t <1> [list showtag $tag 1]
3836             set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3837         } else {
3838             # draw a head or other ref
3839             if {[incr nheads -1] >= 0} {
3840                 set col green
3841                 if {$tag eq $mainhead} {
3842                     lappend font bold
3843                 }
3844             } else {
3845                 set col "#ddddff"
3846             }
3847             set xl [expr {$xl - $delta/2}]
3848             $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3849                 -width 1 -outline black -fill $col -tags tag.$id
3850             if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3851                 set rwid [font measure $mainfont $remoteprefix]
3852                 set xi [expr {$x + 1}]
3853                 set yti [expr {$yt + 1}]
3854                 set xri [expr {$x + $rwid}]
3855                 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3856                         -width 0 -fill "#ffddaa" -tags tag.$id
3857             }
3858         }
3859         set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3860                    -font $font -tags [list tag.$id text]]
3861         if {$ntags >= 0} {
3862             $canv bind $t <1> [list showtag $tag 1]
3863         } elseif {$nheads >= 0} {
3864             $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3865         }
3866     }
3867     return $xt
3868 }
3869
3870 proc xcoord {i level ln} {
3871     global canvx0 xspc1 xspc2
3872
3873     set x [expr {$canvx0 + $i * $xspc1($ln)}]
3874     if {$i > 0 && $i == $level} {
3875         set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3876     } elseif {$i > $level} {
3877         set x [expr {$x + $xspc2 - $xspc1($ln)}]
3878     }
3879     return $x
3880 }
3881
3882 proc show_status {msg} {
3883     global canv mainfont fgcolor
3884
3885     clear_display
3886     $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3887         -tags text -fill $fgcolor
3888 }
3889
3890 # Insert a new commit as the child of the commit on row $row.
3891 # The new commit will be displayed on row $row and the commits
3892 # on that row and below will move down one row.
3893 proc insertrow {row newcmit} {
3894     global displayorder parentlist commitlisted children
3895     global commitrow curview rowidlist rowoffsets numcommits
3896     global rowrangelist rowlaidout rowoptim numcommits
3897     global selectedline rowchk commitidx
3898
3899     if {$row >= $numcommits} {
3900         puts "oops, inserting new row $row but only have $numcommits rows"
3901         return
3902     }
3903     set p [lindex $displayorder $row]
3904     set displayorder [linsert $displayorder $row $newcmit]
3905     set parentlist [linsert $parentlist $row $p]
3906     set kids $children($curview,$p)
3907     lappend kids $newcmit
3908     set children($curview,$p) $kids
3909     set children($curview,$newcmit) {}
3910     set commitlisted [linsert $commitlisted $row 1]
3911     set l [llength $displayorder]
3912     for {set r $row} {$r < $l} {incr r} {
3913         set id [lindex $displayorder $r]
3914         set commitrow($curview,$id) $r
3915     }
3916     incr commitidx($curview)
3917
3918     set idlist [lindex $rowidlist $row]
3919     set offs [lindex $rowoffsets $row]
3920     set newoffs {}
3921     foreach x $idlist {
3922         if {$x eq {} || ($x eq $p && [llength $kids] == 1)} {
3923             lappend newoffs {}
3924         } else {
3925             lappend newoffs 0
3926         }
3927     }
3928     if {[llength $kids] == 1} {
3929         set col [lsearch -exact $idlist $p]
3930         lset idlist $col $newcmit
3931     } else {
3932         set col [llength $idlist]
3933         lappend idlist $newcmit
3934         lappend offs {}
3935         lset rowoffsets $row $offs
3936     }
3937     set rowidlist [linsert $rowidlist $row $idlist]
3938     set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs]
3939
3940     set rowrangelist [linsert $rowrangelist $row {}]
3941     if {[llength $kids] > 1} {
3942         set rp1 [expr {$row + 1}]
3943         set ranges [lindex $rowrangelist $rp1]
3944         if {$ranges eq {}} {
3945             set ranges [list $newcmit $p]
3946         } elseif {[lindex $ranges end-1] eq $p} {
3947             lset ranges end-1 $newcmit
3948         }
3949         lset rowrangelist $rp1 $ranges
3950     }
3951
3952     catch {unset rowchk}
3953
3954     incr rowlaidout
3955     incr rowoptim
3956     incr numcommits
3957
3958     if {[info exists selectedline] && $selectedline >= $row} {
3959         incr selectedline
3960     }
3961     redisplay
3962 }
3963
3964 # Remove a commit that was inserted with insertrow on row $row.
3965 proc removerow {row} {
3966     global displayorder parentlist commitlisted children
3967     global commitrow curview rowidlist rowoffsets numcommits
3968     global rowrangelist idrowranges rowlaidout rowoptim numcommits
3969     global linesegends selectedline rowchk commitidx
3970
3971     if {$row >= $numcommits} {
3972         puts "oops, removing row $row but only have $numcommits rows"
3973         return
3974     }
3975     set rp1 [expr {$row + 1}]
3976     set id [lindex $displayorder $row]
3977     set p [lindex $parentlist $row]
3978     set displayorder [lreplace $displayorder $row $row]
3979     set parentlist [lreplace $parentlist $row $row]
3980     set commitlisted [lreplace $commitlisted $row $row]
3981     set kids $children($curview,$p)
3982     set i [lsearch -exact $kids $id]
3983     if {$i >= 0} {
3984         set kids [lreplace $kids $i $i]
3985         set children($curview,$p) $kids
3986     }
3987     set l [llength $displayorder]
3988     for {set r $row} {$r < $l} {incr r} {
3989         set id [lindex $displayorder $r]
3990         set commitrow($curview,$id) $r
3991     }
3992     incr commitidx($curview) -1
3993
3994     set rowidlist [lreplace $rowidlist $row $row]
3995     set rowoffsets [lreplace $rowoffsets $rp1 $rp1]
3996     if {$kids ne {}} {
3997         set offs [lindex $rowoffsets $row]
3998         set offs [lreplace $offs end end]
3999         lset rowoffsets $row $offs
4000     }
4001
4002     set rowrangelist [lreplace $rowrangelist $row $row]
4003     if {[llength $kids] > 0} {
4004         set ranges [lindex $rowrangelist $row]
4005         if {[lindex $ranges end-1] eq $id} {
4006             set ranges [lreplace $ranges end-1 end]
4007             lset rowrangelist $row $ranges
4008         }
4009     }
4010
4011     catch {unset rowchk}
4012
4013     incr rowlaidout -1
4014     incr rowoptim -1
4015     incr numcommits -1
4016
4017     if {[info exists selectedline] && $selectedline > $row} {
4018         incr selectedline -1
4019     }
4020     redisplay
4021 }
4022
4023 # Don't change the text pane cursor if it is currently the hand cursor,
4024 # showing that we are over a sha1 ID link.
4025 proc settextcursor {c} {
4026     global ctext curtextcursor
4027
4028     if {[$ctext cget -cursor] == $curtextcursor} {
4029         $ctext config -cursor $c
4030     }
4031     set curtextcursor $c
4032 }
4033
4034 proc nowbusy {what} {
4035     global isbusy
4036
4037     if {[array names isbusy] eq {}} {
4038         . config -cursor watch
4039         settextcursor watch
4040     }
4041     set isbusy($what) 1
4042 }
4043
4044 proc notbusy {what} {
4045     global isbusy maincursor textcursor
4046
4047     catch {unset isbusy($what)}
4048     if {[array names isbusy] eq {}} {
4049         . config -cursor $maincursor
4050         settextcursor $textcursor
4051     }
4052 }
4053
4054 proc findmatches {f} {
4055     global findtype findstring
4056     if {$findtype == "Regexp"} {
4057         set matches [regexp -indices -all -inline $findstring $f]
4058     } else {
4059         set fs $findstring
4060         if {$findtype == "IgnCase"} {
4061             set f [string tolower $f]
4062             set fs [string tolower $fs]
4063         }
4064         set matches {}
4065         set i 0
4066         set l [string length $fs]
4067         while {[set j [string first $fs $f $i]] >= 0} {
4068             lappend matches [list $j [expr {$j+$l-1}]]
4069             set i [expr {$j + $l}]
4070         }
4071     }
4072     return $matches
4073 }
4074
4075 proc dofind {{rev 0}} {
4076     global findstring findstartline findcurline selectedline numcommits
4077
4078     unmarkmatches
4079     cancel_next_highlight
4080     focus .
4081     if {$findstring eq {} || $numcommits == 0} return
4082     if {![info exists selectedline]} {
4083         set findstartline [lindex [visiblerows] $rev]
4084     } else {
4085         set findstartline $selectedline
4086     }
4087     set findcurline $findstartline
4088     nowbusy finding
4089     if {!$rev} {
4090         run findmore
4091     } else {
4092         if {$findcurline == 0} {
4093             set findcurline $numcommits
4094         }
4095         incr findcurline -1
4096         run findmorerev
4097     }
4098 }
4099
4100 proc findnext {restart} {
4101     global findcurline
4102     if {![info exists findcurline]} {
4103         if {$restart} {
4104             dofind
4105         } else {
4106             bell
4107         }
4108     } else {
4109         run findmore
4110         nowbusy finding
4111     }
4112 }
4113
4114 proc findprev {} {
4115     global findcurline
4116     if {![info exists findcurline]} {
4117         dofind 1
4118     } else {
4119         run findmorerev
4120         nowbusy finding
4121     }
4122 }
4123
4124 proc findmore {} {
4125     global commitdata commitinfo numcommits findstring findpattern findloc
4126     global findstartline findcurline displayorder
4127
4128     set fldtypes {Headline Author Date Committer CDate Comments}
4129     set l [expr {$findcurline + 1}]
4130     if {$l >= $numcommits} {
4131         set l 0
4132     }
4133     if {$l <= $findstartline} {
4134         set lim [expr {$findstartline + 1}]
4135     } else {
4136         set lim $numcommits
4137     }
4138     if {$lim - $l > 500} {
4139         set lim [expr {$l + 500}]
4140     }
4141     set last 0
4142     for {} {$l < $lim} {incr l} {
4143         set id [lindex $displayorder $l]
4144         # shouldn't happen unless git log doesn't give all the commits...
4145         if {![info exists commitdata($id)]} continue
4146         if {![doesmatch $commitdata($id)]} continue
4147         if {![info exists commitinfo($id)]} {
4148             getcommit $id
4149         }
4150         set info $commitinfo($id)
4151         foreach f $info ty $fldtypes {
4152             if {($findloc eq "All fields" || $findloc eq $ty) &&
4153                 [doesmatch $f]} {
4154                 findselectline $l
4155                 notbusy finding
4156                 return 0
4157             }
4158         }
4159     }
4160     if {$l == $findstartline + 1} {
4161         bell
4162         unset findcurline
4163         notbusy finding
4164         return 0
4165     }
4166     set findcurline [expr {$l - 1}]
4167     return 1
4168 }
4169
4170 proc findmorerev {} {
4171     global commitdata commitinfo numcommits findstring findpattern findloc
4172     global findstartline findcurline displayorder
4173
4174     set fldtypes {Headline Author Date Committer CDate Comments}
4175     set l $findcurline
4176     if {$l == 0} {
4177         set l $numcommits
4178     }
4179     incr l -1
4180     if {$l >= $findstartline} {
4181         set lim [expr {$findstartline - 1}]
4182     } else {
4183         set lim -1
4184     }
4185     if {$l - $lim > 500} {
4186         set lim [expr {$l - 500}]
4187     }
4188     set last 0
4189     for {} {$l > $lim} {incr l -1} {
4190         set id [lindex $displayorder $l]
4191         if {![doesmatch $commitdata($id)]} continue
4192         if {![info exists commitinfo($id)]} {
4193             getcommit $id
4194         }
4195         set info $commitinfo($id)
4196         foreach f $info ty $fldtypes {
4197             if {($findloc eq "All fields" || $findloc eq $ty) &&
4198                 [doesmatch $f]} {
4199                 findselectline $l
4200                 notbusy finding
4201                 return 0
4202             }
4203         }
4204     }
4205     if {$l == -1} {
4206         bell
4207         unset findcurline
4208         notbusy finding
4209         return 0
4210     }
4211     set findcurline [expr {$l + 1}]
4212     return 1
4213 }
4214
4215 proc findselectline {l} {
4216     global findloc commentend ctext findcurline markingmatches
4217
4218     set markingmatches 1
4219     set findcurline $l
4220     selectline $l 1
4221     if {$findloc == "All fields" || $findloc == "Comments"} {
4222         # highlight the matches in the comments
4223         set f [$ctext get 1.0 $commentend]
4224         set matches [findmatches $f]
4225         foreach match $matches {
4226             set start [lindex $match 0]
4227             set end [expr {[lindex $match 1] + 1}]
4228             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4229         }
4230     }
4231     drawvisible
4232 }
4233
4234 # mark the bits of a headline or author that match a find string
4235 proc markmatches {canv l str tag matches font row} {
4236     global selectedline
4237
4238     set bbox [$canv bbox $tag]
4239     set x0 [lindex $bbox 0]
4240     set y0 [lindex $bbox 1]
4241     set y1 [lindex $bbox 3]
4242     foreach match $matches {
4243         set start [lindex $match 0]
4244         set end [lindex $match 1]
4245         if {$start > $end} continue
4246         set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4247         set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4248         set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4249                    [expr {$x0+$xlen+2}] $y1 \
4250                    -outline {} -tags [list match$l matches] -fill yellow]
4251         $canv lower $t
4252         if {[info exists selectedline] && $row == $selectedline} {
4253             $canv raise $t secsel
4254         }
4255     }
4256 }
4257
4258 proc unmarkmatches {} {
4259     global findids markingmatches findcurline
4260
4261     allcanvs delete matches
4262     catch {unset findids}
4263     set markingmatches 0
4264     catch {unset findcurline}
4265 }
4266
4267 proc selcanvline {w x y} {
4268     global canv canvy0 ctext linespc
4269     global rowtextx
4270     set ymax [lindex [$canv cget -scrollregion] 3]
4271     if {$ymax == {}} return
4272     set yfrac [lindex [$canv yview] 0]
4273     set y [expr {$y + $yfrac * $ymax}]
4274     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4275     if {$l < 0} {
4276         set l 0
4277     }
4278     if {$w eq $canv} {
4279         if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4280     }
4281     unmarkmatches
4282     selectline $l 1
4283 }
4284
4285 proc commit_descriptor {p} {
4286     global commitinfo
4287     if {![info exists commitinfo($p)]} {
4288         getcommit $p
4289     }
4290     set l "..."
4291     if {[llength $commitinfo($p)] > 1} {
4292         set l [lindex $commitinfo($p) 0]
4293     }
4294     return "$p ($l)\n"
4295 }
4296
4297 # append some text to the ctext widget, and make any SHA1 ID
4298 # that we know about be a clickable link.
4299 proc appendwithlinks {text tags} {
4300     global ctext commitrow linknum curview
4301
4302     set start [$ctext index "end - 1c"]
4303     $ctext insert end $text $tags
4304     set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4305     foreach l $links {
4306         set s [lindex $l 0]
4307         set e [lindex $l 1]
4308         set linkid [string range $text $s $e]
4309         if {![info exists commitrow($curview,$linkid)]} continue
4310         incr e
4311         $ctext tag add link "$start + $s c" "$start + $e c"
4312         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4313         $ctext tag bind link$linknum <1> \
4314             [list selectline $commitrow($curview,$linkid) 1]
4315         incr linknum
4316     }
4317     $ctext tag conf link -foreground blue -underline 1
4318     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4319     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4320 }
4321
4322 proc viewnextline {dir} {
4323     global canv linespc
4324
4325     $canv delete hover
4326     set ymax [lindex [$canv cget -scrollregion] 3]
4327     set wnow [$canv yview]
4328     set wtop [expr {[lindex $wnow 0] * $ymax}]
4329     set newtop [expr {$wtop + $dir * $linespc}]
4330     if {$newtop < 0} {
4331         set newtop 0
4332     } elseif {$newtop > $ymax} {
4333         set newtop $ymax
4334     }
4335     allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4336 }
4337
4338 # add a list of tag or branch names at position pos
4339 # returns the number of names inserted
4340 proc appendrefs {pos ids var} {
4341     global ctext commitrow linknum curview $var maxrefs
4342
4343     if {[catch {$ctext index $pos}]} {
4344         return 0
4345     }
4346     $ctext conf -state normal
4347     $ctext delete $pos "$pos lineend"
4348     set tags {}
4349     foreach id $ids {
4350         foreach tag [set $var\($id\)] {
4351             lappend tags [list $tag $id]
4352         }
4353     }
4354     if {[llength $tags] > $maxrefs} {
4355         $ctext insert $pos "many ([llength $tags])"
4356     } else {
4357         set tags [lsort -index 0 -decreasing $tags]
4358         set sep {}
4359         foreach ti $tags {
4360             set id [lindex $ti 1]
4361             set lk link$linknum
4362             incr linknum
4363             $ctext tag delete $lk
4364             $ctext insert $pos $sep
4365             $ctext insert $pos [lindex $ti 0] $lk
4366             if {[info exists commitrow($curview,$id)]} {
4367                 $ctext tag conf $lk -foreground blue
4368                 $ctext tag bind $lk <1> \
4369                     [list selectline $commitrow($curview,$id) 1]
4370                 $ctext tag conf $lk -underline 1
4371                 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
4372                 $ctext tag bind $lk <Leave> \
4373                     { %W configure -cursor $curtextcursor }
4374             }
4375             set sep ", "
4376         }
4377     }
4378     $ctext conf -state disabled
4379     return [llength $tags]
4380 }
4381
4382 # called when we have finished computing the nearby tags
4383 proc dispneartags {delay} {
4384     global selectedline currentid showneartags tagphase
4385
4386     if {![info exists selectedline] || !$showneartags} return
4387     after cancel dispnexttag
4388     if {$delay} {
4389         after 200 dispnexttag
4390         set tagphase -1
4391     } else {
4392         after idle dispnexttag
4393         set tagphase 0
4394     }
4395 }
4396
4397 proc dispnexttag {} {
4398     global selectedline currentid showneartags tagphase ctext
4399
4400     if {![info exists selectedline] || !$showneartags} return
4401     switch -- $tagphase {
4402         0 {
4403             set dtags [desctags $currentid]
4404             if {$dtags ne {}} {
4405                 appendrefs precedes $dtags idtags
4406             }
4407         }
4408         1 {
4409             set atags [anctags $currentid]
4410             if {$atags ne {}} {
4411                 appendrefs follows $atags idtags
4412             }
4413         }
4414         2 {
4415             set dheads [descheads $currentid]
4416             if {$dheads ne {}} {
4417                 if {[appendrefs branch $dheads idheads] > 1
4418                     && [$ctext get "branch -3c"] eq "h"} {
4419                     # turn "Branch" into "Branches"
4420                     $ctext conf -state normal
4421                     $ctext insert "branch -2c" "es"
4422                     $ctext conf -state disabled
4423                 }
4424             }
4425         }
4426     }
4427     if {[incr tagphase] <= 2} {
4428         after idle dispnexttag
4429     }
4430 }
4431
4432 proc selectline {l isnew} {
4433     global canv canv2 canv3 ctext commitinfo selectedline
4434     global displayorder linehtag linentag linedtag
4435     global canvy0 linespc parentlist children curview
4436     global currentid sha1entry
4437     global commentend idtags linknum
4438     global mergemax numcommits pending_select
4439     global cmitmode showneartags allcommits
4440
4441     catch {unset pending_select}
4442     $canv delete hover
4443     normalline
4444     cancel_next_highlight
4445     if {$l < 0 || $l >= $numcommits} return
4446     set y [expr {$canvy0 + $l * $linespc}]
4447     set ymax [lindex [$canv cget -scrollregion] 3]
4448     set ytop [expr {$y - $linespc - 1}]
4449     set ybot [expr {$y + $linespc + 1}]
4450     set wnow [$canv yview]
4451     set wtop [expr {[lindex $wnow 0] * $ymax}]
4452     set wbot [expr {[lindex $wnow 1] * $ymax}]
4453     set wh [expr {$wbot - $wtop}]
4454     set newtop $wtop
4455     if {$ytop < $wtop} {
4456         if {$ybot < $wtop} {
4457             set newtop [expr {$y - $wh / 2.0}]
4458         } else {
4459             set newtop $ytop
4460             if {$newtop > $wtop - $linespc} {
4461                 set newtop [expr {$wtop - $linespc}]
4462             }
4463         }
4464     } elseif {$ybot > $wbot} {
4465         if {$ytop > $wbot} {
4466             set newtop [expr {$y - $wh / 2.0}]
4467         } else {
4468             set newtop [expr {$ybot - $wh}]
4469             if {$newtop < $wtop + $linespc} {
4470                 set newtop [expr {$wtop + $linespc}]
4471             }
4472         }
4473     }
4474     if {$newtop != $wtop} {
4475         if {$newtop < 0} {
4476             set newtop 0
4477         }
4478         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4479         drawvisible
4480     }
4481
4482     if {![info exists linehtag($l)]} return
4483     $canv delete secsel
4484     set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4485                -tags secsel -fill [$canv cget -selectbackground]]
4486     $canv lower $t
4487     $canv2 delete secsel
4488     set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4489                -tags secsel -fill [$canv2 cget -selectbackground]]
4490     $canv2 lower $t
4491     $canv3 delete secsel
4492     set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4493                -tags secsel -fill [$canv3 cget -selectbackground]]
4494     $canv3 lower $t
4495
4496     if {$isnew} {
4497         addtohistory [list selectline $l 0]
4498     }
4499
4500     set selectedline $l
4501
4502     set id [lindex $displayorder $l]
4503     set currentid $id
4504     $sha1entry delete 0 end
4505     $sha1entry insert 0 $id
4506     $sha1entry selection from 0
4507     $sha1entry selection to end
4508     rhighlight_sel $id
4509
4510     $ctext conf -state normal
4511     clear_ctext
4512     set linknum 0
4513     set info $commitinfo($id)
4514     set date [formatdate [lindex $info 2]]
4515     $ctext insert end "Author: [lindex $info 1]  $date\n"
4516     set date [formatdate [lindex $info 4]]
4517     $ctext insert end "Committer: [lindex $info 3]  $date\n"
4518     if {[info exists idtags($id)]} {
4519         $ctext insert end "Tags:"
4520         foreach tag $idtags($id) {
4521             $ctext insert end " $tag"
4522         }
4523         $ctext insert end "\n"
4524     }
4525
4526     set headers {}
4527     set olds [lindex $parentlist $l]
4528     if {[llength $olds] > 1} {
4529         set np 0
4530         foreach p $olds {
4531             if {$np >= $mergemax} {
4532                 set tag mmax
4533             } else {
4534                 set tag m$np
4535             }
4536             $ctext insert end "Parent: " $tag
4537             appendwithlinks [commit_descriptor $p] {}
4538             incr np
4539         }
4540     } else {
4541         foreach p $olds {
4542             append headers "Parent: [commit_descriptor $p]"
4543         }
4544     }
4545
4546     foreach c $children($curview,$id) {
4547         append headers "Child:  [commit_descriptor $c]"
4548     }
4549
4550     # make anything that looks like a SHA1 ID be a clickable link
4551     appendwithlinks $headers {}
4552     if {$showneartags} {
4553         if {![info exists allcommits]} {
4554             getallcommits
4555         }
4556         $ctext insert end "Branch: "
4557         $ctext mark set branch "end -1c"
4558         $ctext mark gravity branch left
4559         $ctext insert end "\nFollows: "
4560         $ctext mark set follows "end -1c"
4561         $ctext mark gravity follows left
4562         $ctext insert end "\nPrecedes: "
4563         $ctext mark set precedes "end -1c"
4564         $ctext mark gravity precedes left
4565         $ctext insert end "\n"
4566         dispneartags 1
4567     }
4568     $ctext insert end "\n"
4569     set comment [lindex $info 5]
4570     if {[string first "\r" $comment] >= 0} {
4571         set comment [string map {"\r" "\n    "} $comment]
4572     }
4573     appendwithlinks $comment {comment}
4574
4575     $ctext tag remove found 1.0 end
4576     $ctext conf -state disabled
4577     set commentend [$ctext index "end - 1c"]
4578
4579     init_flist "Comments"
4580     if {$cmitmode eq "tree"} {
4581         gettree $id
4582     } elseif {[llength $olds] <= 1} {
4583         startdiff $id
4584     } else {
4585         mergediff $id $l
4586     }
4587 }
4588
4589 proc selfirstline {} {
4590     unmarkmatches
4591     selectline 0 1
4592 }
4593
4594 proc sellastline {} {
4595     global numcommits
4596     unmarkmatches
4597     set l [expr {$numcommits - 1}]
4598     selectline $l 1
4599 }
4600
4601 proc selnextline {dir} {
4602     global selectedline
4603     focus .
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     focus .
4685
4686     if {$historyindex > 1} {
4687         incr historyindex -1
4688         godo [lindex $history [expr {$historyindex - 1}]]
4689         .tf.bar.rightbut conf -state normal
4690     }
4691     if {$historyindex <= 1} {
4692         .tf.bar.leftbut conf -state disabled
4693     }
4694 }
4695
4696 proc goforw {} {
4697     global history historyindex
4698     focus .
4699
4700     if {$historyindex < [llength $history]} {
4701         set cmd [lindex $history $historyindex]
4702         incr historyindex
4703         godo $cmd
4704         .tf.bar.leftbut conf -state normal
4705     }
4706     if {$historyindex >= [llength $history]} {
4707         .tf.bar.rightbut conf -state disabled
4708     }
4709 }
4710
4711 proc gettree {id} {
4712     global treefilelist treeidlist diffids diffmergeid treepending
4713     global nullid nullid2
4714
4715     set diffids $id
4716     catch {unset diffmergeid}
4717     if {![info exists treefilelist($id)]} {
4718         if {![info exists treepending]} {
4719             if {$id eq $nullid} {
4720                 set cmd [list | git ls-files]
4721             } elseif {$id eq $nullid2} {
4722                 set cmd [list | git ls-files --stage -t]
4723             } else {
4724                 set cmd [list | git ls-tree -r $id]
4725             }
4726             if {[catch {set gtf [open $cmd r]}]} {
4727                 return
4728             }
4729             set treepending $id
4730             set treefilelist($id) {}
4731             set treeidlist($id) {}
4732             fconfigure $gtf -blocking 0
4733             filerun $gtf [list gettreeline $gtf $id]
4734         }
4735     } else {
4736         setfilelist $id
4737     }
4738 }
4739
4740 proc gettreeline {gtf id} {
4741     global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
4742
4743     set nl 0
4744     while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4745         if {$diffids eq $nullid} {
4746             set fname $line
4747         } else {
4748             if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
4749             set i [string first "\t" $line]
4750             if {$i < 0} continue
4751             set sha1 [lindex $line 2]
4752             set fname [string range $line [expr {$i+1}] end]
4753             if {[string index $fname 0] eq "\""} {
4754                 set fname [lindex $fname 0]
4755             }
4756             lappend treeidlist($id) $sha1
4757         }
4758         lappend treefilelist($id) $fname
4759     }
4760     if {![eof $gtf]} {
4761         return [expr {$nl >= 1000? 2: 1}]
4762     }
4763     close $gtf
4764     unset treepending
4765     if {$cmitmode ne "tree"} {
4766         if {![info exists diffmergeid]} {
4767             gettreediffs $diffids
4768         }
4769     } elseif {$id ne $diffids} {
4770         gettree $diffids
4771     } else {
4772         setfilelist $id
4773     }
4774     return 0
4775 }
4776
4777 proc showfile {f} {
4778     global treefilelist treeidlist diffids nullid nullid2
4779     global ctext commentend
4780
4781     set i [lsearch -exact $treefilelist($diffids) $f]
4782     if {$i < 0} {
4783         puts "oops, $f not in list for id $diffids"
4784         return
4785     }
4786     if {$diffids eq $nullid} {
4787         if {[catch {set bf [open $f r]} err]} {
4788             puts "oops, can't read $f: $err"
4789             return
4790         }
4791     } else {
4792         set blob [lindex $treeidlist($diffids) $i]
4793         if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4794             puts "oops, error reading blob $blob: $err"
4795             return
4796         }
4797     }
4798     fconfigure $bf -blocking 0
4799     filerun $bf [list getblobline $bf $diffids]
4800     $ctext config -state normal
4801     clear_ctext $commentend
4802     $ctext insert end "\n"
4803     $ctext insert end "$f\n" filesep
4804     $ctext config -state disabled
4805     $ctext yview $commentend
4806 }
4807
4808 proc getblobline {bf id} {
4809     global diffids cmitmode ctext
4810
4811     if {$id ne $diffids || $cmitmode ne "tree"} {
4812         catch {close $bf}
4813         return 0
4814     }
4815     $ctext config -state normal
4816     set nl 0
4817     while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
4818         $ctext insert end "$line\n"
4819     }
4820     if {[eof $bf]} {
4821         # delete last newline
4822         $ctext delete "end - 2c" "end - 1c"
4823         close $bf
4824         return 0
4825     }
4826     $ctext config -state disabled
4827     return [expr {$nl >= 1000? 2: 1}]
4828 }
4829
4830 proc mergediff {id l} {
4831     global diffmergeid diffopts mdifffd
4832     global diffids
4833     global parentlist
4834
4835     set diffmergeid $id
4836     set diffids $id
4837     # this doesn't seem to actually affect anything...
4838     set env(GIT_DIFF_OPTS) $diffopts
4839     set cmd [concat | git diff-tree --no-commit-id --cc $id]
4840     if {[catch {set mdf [open $cmd r]} err]} {
4841         error_popup "Error getting merge diffs: $err"
4842         return
4843     }
4844     fconfigure $mdf -blocking 0
4845     set mdifffd($id) $mdf
4846     set np [llength [lindex $parentlist $l]]
4847     filerun $mdf [list getmergediffline $mdf $id $np]
4848 }
4849
4850 proc getmergediffline {mdf id np} {
4851     global diffmergeid ctext cflist mergemax
4852     global difffilestart mdifffd
4853
4854     $ctext conf -state normal
4855     set nr 0
4856     while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
4857         if {![info exists diffmergeid] || $id != $diffmergeid
4858             || $mdf != $mdifffd($id)} {
4859             close $mdf
4860             return 0
4861         }
4862         if {[regexp {^diff --cc (.*)} $line match fname]} {
4863             # start of a new file
4864             $ctext insert end "\n"
4865             set here [$ctext index "end - 1c"]
4866             lappend difffilestart $here
4867             add_flist [list $fname]
4868             set l [expr {(78 - [string length $fname]) / 2}]
4869             set pad [string range "----------------------------------------" 1 $l]
4870             $ctext insert end "$pad $fname $pad\n" filesep
4871         } elseif {[regexp {^@@} $line]} {
4872             $ctext insert end "$line\n" hunksep
4873         } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4874             # do nothing
4875         } else {
4876             # parse the prefix - one ' ', '-' or '+' for each parent
4877             set spaces {}
4878             set minuses {}
4879             set pluses {}
4880             set isbad 0
4881             for {set j 0} {$j < $np} {incr j} {
4882                 set c [string range $line $j $j]
4883                 if {$c == " "} {
4884                     lappend spaces $j
4885                 } elseif {$c == "-"} {
4886                     lappend minuses $j
4887                 } elseif {$c == "+"} {
4888                     lappend pluses $j
4889                 } else {
4890                     set isbad 1
4891                     break
4892                 }
4893             }
4894             set tags {}
4895             set num {}
4896             if {!$isbad && $minuses ne {} && $pluses eq {}} {
4897                 # line doesn't appear in result, parents in $minuses have the line
4898                 set num [lindex $minuses 0]
4899             } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4900                 # line appears in result, parents in $pluses don't have the line
4901                 lappend tags mresult
4902                 set num [lindex $spaces 0]
4903             }
4904             if {$num ne {}} {
4905                 if {$num >= $mergemax} {
4906                     set num "max"
4907                 }
4908                 lappend tags m$num
4909             }
4910             $ctext insert end "$line\n" $tags
4911         }
4912     }
4913     $ctext conf -state disabled
4914     if {[eof $mdf]} {
4915         close $mdf
4916         return 0
4917     }
4918     return [expr {$nr >= 1000? 2: 1}]
4919 }
4920
4921 proc startdiff {ids} {
4922     global treediffs diffids treepending diffmergeid nullid nullid2
4923
4924     set diffids $ids
4925     catch {unset diffmergeid}
4926     if {![info exists treediffs($ids)] ||
4927         [lsearch -exact $ids $nullid] >= 0 ||
4928         [lsearch -exact $ids $nullid2] >= 0} {
4929         if {![info exists treepending]} {
4930             gettreediffs $ids
4931         }
4932     } else {
4933         addtocflist $ids
4934     }
4935 }
4936
4937 proc addtocflist {ids} {
4938     global treediffs cflist
4939     add_flist $treediffs($ids)
4940     getblobdiffs $ids
4941 }
4942
4943 proc diffcmd {ids flags} {
4944     global nullid nullid2
4945
4946     set i [lsearch -exact $ids $nullid]
4947     set j [lsearch -exact $ids $nullid2]
4948     if {$i >= 0} {
4949         if {[llength $ids] > 1 && $j < 0} {
4950             # comparing working directory with some specific revision
4951             set cmd [concat | git diff-index $flags]
4952             if {$i == 0} {
4953                 lappend cmd -R [lindex $ids 1]
4954             } else {
4955                 lappend cmd [lindex $ids 0]
4956             }
4957         } else {
4958             # comparing working directory with index
4959             set cmd [concat | git diff-files $flags]
4960             if {$j == 1} {
4961                 lappend cmd -R
4962             }
4963         }
4964     } elseif {$j >= 0} {
4965         set cmd [concat | git diff-index --cached $flags]
4966         if {[llength $ids] > 1} {
4967             # comparing index with specific revision
4968             if {$i == 0} {
4969                 lappend cmd -R [lindex $ids 1]
4970             } else {
4971                 lappend cmd [lindex $ids 0]
4972             }
4973         } else {
4974             # comparing index with HEAD
4975             lappend cmd HEAD
4976         }
4977     } else {
4978         set cmd [concat | git diff-tree -r $flags $ids]
4979     }
4980     return $cmd
4981 }
4982
4983 proc gettreediffs {ids} {
4984     global treediff treepending
4985
4986     set treepending $ids
4987     set treediff {}
4988     if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
4989     fconfigure $gdtf -blocking 0
4990     filerun $gdtf [list gettreediffline $gdtf $ids]
4991 }
4992
4993 proc gettreediffline {gdtf ids} {
4994     global treediff treediffs treepending diffids diffmergeid
4995     global cmitmode
4996
4997     set nr 0
4998     while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
4999         set i [string first "\t" $line]
5000         if {$i >= 0} {
5001             set file [string range $line [expr {$i+1}] end]
5002             if {[string index $file 0] eq "\""} {
5003                 set file [lindex $file 0]
5004             }
5005             lappend treediff $file
5006         }
5007     }
5008     if {![eof $gdtf]} {
5009         return [expr {$nr >= 1000? 2: 1}]
5010     }
5011     close $gdtf
5012     set treediffs($ids) $treediff
5013     unset treepending
5014     if {$cmitmode eq "tree"} {
5015         gettree $diffids
5016     } elseif {$ids != $diffids} {
5017         if {![info exists diffmergeid]} {
5018             gettreediffs $diffids
5019         }
5020     } else {
5021         addtocflist $ids
5022     }
5023     return 0
5024 }
5025
5026 proc getblobdiffs {ids} {
5027     global diffopts blobdifffd diffids env
5028     global diffinhdr treediffs
5029
5030     set env(GIT_DIFF_OPTS) $diffopts
5031     if {[catch {set bdf [open [diffcmd $ids {-p -C --no-commit-id}] r]} err]} {
5032         puts "error getting diffs: $err"
5033         return
5034     }
5035     set diffinhdr 0
5036     fconfigure $bdf -blocking 0
5037     set blobdifffd($ids) $bdf
5038     filerun $bdf [list getblobdiffline $bdf $diffids]
5039 }
5040
5041 proc setinlist {var i val} {
5042     global $var
5043
5044     while {[llength [set $var]] < $i} {
5045         lappend $var {}
5046     }
5047     if {[llength [set $var]] == $i} {
5048         lappend $var $val
5049     } else {
5050         lset $var $i $val
5051     }
5052 }
5053
5054 proc makediffhdr {fname ids} {
5055     global ctext curdiffstart treediffs
5056
5057     set i [lsearch -exact $treediffs($ids) $fname]
5058     if {$i >= 0} {
5059         setinlist difffilestart $i $curdiffstart
5060     }
5061     set l [expr {(78 - [string length $fname]) / 2}]
5062     set pad [string range "----------------------------------------" 1 $l]
5063     $ctext insert $curdiffstart "$pad $fname $pad" filesep
5064 }
5065
5066 proc getblobdiffline {bdf ids} {
5067     global diffids blobdifffd ctext curdiffstart
5068     global diffnexthead diffnextnote difffilestart
5069     global diffinhdr treediffs
5070
5071     set nr 0
5072     $ctext conf -state normal
5073     while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
5074         if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
5075             close $bdf
5076             return 0
5077         }
5078         if {![string compare -length 11 "diff --git " $line]} {
5079             # trim off "diff --git "
5080             set line [string range $line 11 end]
5081             set diffinhdr 1
5082             # start of a new file
5083             $ctext insert end "\n"
5084             set curdiffstart [$ctext index "end - 1c"]
5085             $ctext insert end "\n" filesep
5086             # If the name hasn't changed the length will be odd,
5087             # the middle char will be a space, and the two bits either
5088             # side will be a/name and b/name, or "a/name" and "b/name".
5089             # If the name has changed we'll get "rename from" and
5090             # "rename to" lines following this, and we'll use them
5091             # to get the filenames.
5092             # This complexity is necessary because spaces in the filename(s)
5093             # don't get escaped.
5094             set l [string length $line]
5095             set i [expr {$l / 2}]
5096             if {!(($l & 1) && [string index $line $i] eq " " &&
5097                   [string range $line 2 [expr {$i - 1}]] eq \
5098                       [string range $line [expr {$i + 3}] end])} {
5099                 continue
5100             }
5101             # unescape if quoted and chop off the a/ from the front
5102             if {[string index $line 0] eq "\""} {
5103                 set fname [string range [lindex $line 0] 2 end]
5104             } else {
5105                 set fname [string range $line 2 [expr {$i - 1}]]
5106             }
5107             makediffhdr $fname $ids
5108
5109         } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
5110                        $line match f1l f1c f2l f2c rest]} {
5111             $ctext insert end "$line\n" hunksep
5112             set diffinhdr 0
5113
5114         } elseif {$diffinhdr} {
5115             if {![string compare -length 12 "rename from " $line]} {
5116                 set fname [string range $line 12 end]
5117                 if {[string index $fname 0] eq "\""} {
5118                     set fname [lindex $fname 0]
5119                 }
5120                 set i [lsearch -exact $treediffs($ids) $fname]
5121                 if {$i >= 0} {
5122                     setinlist difffilestart $i $curdiffstart
5123                 }
5124             } elseif {![string compare -length 10 $line "rename to "]} {
5125                 set fname [string range $line 10 end]
5126                 if {[string index $fname 0] eq "\""} {
5127                     set fname [lindex $fname 0]
5128                 }
5129                 makediffhdr $fname $ids
5130             } elseif {[string compare -length 3 $line "---"] == 0} {
5131                 # do nothing
5132                 continue
5133             } elseif {[string compare -length 3 $line "+++"] == 0} {
5134                 set diffinhdr 0
5135                 continue
5136             }
5137             $ctext insert end "$line\n" filesep
5138
5139         } else {
5140             set x [string range $line 0 0]
5141             if {$x == "-" || $x == "+"} {
5142                 set tag [expr {$x == "+"}]
5143                 $ctext insert end "$line\n" d$tag
5144             } elseif {$x == " "} {
5145                 $ctext insert end "$line\n"
5146             } else {
5147                 # "\ No newline at end of file",
5148                 # or something else we don't recognize
5149                 $ctext insert end "$line\n" hunksep
5150             }
5151         }
5152     }
5153     $ctext conf -state disabled
5154     if {[eof $bdf]} {
5155         close $bdf
5156         return 0
5157     }
5158     return [expr {$nr >= 1000? 2: 1}]
5159 }
5160
5161 proc changediffdisp {} {
5162     global ctext diffelide
5163
5164     $ctext tag conf d0 -elide [lindex $diffelide 0]
5165     $ctext tag conf d1 -elide [lindex $diffelide 1]
5166 }
5167
5168 proc prevfile {} {
5169     global difffilestart ctext
5170     set prev [lindex $difffilestart 0]
5171     set here [$ctext index @0,0]
5172     foreach loc $difffilestart {
5173         if {[$ctext compare $loc >= $here]} {
5174             $ctext yview $prev
5175             return
5176         }
5177         set prev $loc
5178     }
5179     $ctext yview $prev
5180 }
5181
5182 proc nextfile {} {
5183     global difffilestart ctext
5184     set here [$ctext index @0,0]
5185     foreach loc $difffilestart {
5186         if {[$ctext compare $loc > $here]} {
5187             $ctext yview $loc
5188             return
5189         }
5190     }
5191 }
5192
5193 proc clear_ctext {{first 1.0}} {
5194     global ctext smarktop smarkbot
5195
5196     set l [lindex [split $first .] 0]
5197     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5198         set smarktop $l
5199     }
5200     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5201         set smarkbot $l
5202     }
5203     $ctext delete $first end
5204 }
5205
5206 proc incrsearch {name ix op} {
5207     global ctext searchstring searchdirn
5208
5209     $ctext tag remove found 1.0 end
5210     if {[catch {$ctext index anchor}]} {
5211         # no anchor set, use start of selection, or of visible area
5212         set sel [$ctext tag ranges sel]
5213         if {$sel ne {}} {
5214             $ctext mark set anchor [lindex $sel 0]
5215         } elseif {$searchdirn eq "-forwards"} {
5216             $ctext mark set anchor @0,0
5217         } else {
5218             $ctext mark set anchor @0,[winfo height $ctext]
5219         }
5220     }
5221     if {$searchstring ne {}} {
5222         set here [$ctext search $searchdirn -- $searchstring anchor]
5223         if {$here ne {}} {
5224             $ctext see $here
5225         }
5226         searchmarkvisible 1
5227     }
5228 }
5229
5230 proc dosearch {} {
5231     global sstring ctext searchstring searchdirn
5232
5233     focus $sstring
5234     $sstring icursor end
5235     set searchdirn -forwards
5236     if {$searchstring ne {}} {
5237         set sel [$ctext tag ranges sel]
5238         if {$sel ne {}} {
5239             set start "[lindex $sel 0] + 1c"
5240         } elseif {[catch {set start [$ctext index anchor]}]} {
5241             set start "@0,0"
5242         }
5243         set match [$ctext search -count mlen -- $searchstring $start]
5244         $ctext tag remove sel 1.0 end
5245         if {$match eq {}} {
5246             bell
5247             return
5248         }
5249         $ctext see $match
5250         set mend "$match + $mlen c"
5251         $ctext tag add sel $match $mend
5252         $ctext mark unset anchor
5253     }
5254 }
5255
5256 proc dosearchback {} {
5257     global sstring ctext searchstring searchdirn
5258
5259     focus $sstring
5260     $sstring icursor end
5261     set searchdirn -backwards
5262     if {$searchstring ne {}} {
5263         set sel [$ctext tag ranges sel]
5264         if {$sel ne {}} {
5265             set start [lindex $sel 0]
5266         } elseif {[catch {set start [$ctext index anchor]}]} {
5267             set start @0,[winfo height $ctext]
5268         }
5269         set match [$ctext search -backwards -count ml -- $searchstring $start]
5270         $ctext tag remove sel 1.0 end
5271         if {$match eq {}} {
5272             bell
5273             return
5274         }
5275         $ctext see $match
5276         set mend "$match + $ml c"
5277         $ctext tag add sel $match $mend
5278         $ctext mark unset anchor
5279     }
5280 }
5281
5282 proc searchmark {first last} {
5283     global ctext searchstring
5284
5285     set mend $first.0
5286     while {1} {
5287         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5288         if {$match eq {}} break
5289         set mend "$match + $mlen c"
5290         $ctext tag add found $match $mend
5291     }
5292 }
5293
5294 proc searchmarkvisible {doall} {
5295     global ctext smarktop smarkbot
5296
5297     set topline [lindex [split [$ctext index @0,0] .] 0]
5298     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5299     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5300         # no overlap with previous
5301         searchmark $topline $botline
5302         set smarktop $topline
5303         set smarkbot $botline
5304     } else {
5305         if {$topline < $smarktop} {
5306             searchmark $topline [expr {$smarktop-1}]
5307             set smarktop $topline
5308         }
5309         if {$botline > $smarkbot} {
5310             searchmark [expr {$smarkbot+1}] $botline
5311             set smarkbot $botline
5312         }
5313     }
5314 }
5315
5316 proc scrolltext {f0 f1} {
5317     global searchstring
5318
5319     .bleft.sb set $f0 $f1
5320     if {$searchstring ne {}} {
5321         searchmarkvisible 0
5322     }
5323 }
5324
5325 proc setcoords {} {
5326     global linespc charspc canvx0 canvy0 mainfont
5327     global xspc1 xspc2 lthickness
5328
5329     set linespc [font metrics $mainfont -linespace]
5330     set charspc [font measure $mainfont "m"]
5331     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5332     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5333     set lthickness [expr {int($linespc / 9) + 1}]
5334     set xspc1(0) $linespc
5335     set xspc2 $linespc
5336 }
5337
5338 proc redisplay {} {
5339     global canv
5340     global selectedline
5341
5342     set ymax [lindex [$canv cget -scrollregion] 3]
5343     if {$ymax eq {} || $ymax == 0} return
5344     set span [$canv yview]
5345     clear_display
5346     setcanvscroll
5347     allcanvs yview moveto [lindex $span 0]
5348     drawvisible
5349     if {[info exists selectedline]} {
5350         selectline $selectedline 0
5351         allcanvs yview moveto [lindex $span 0]
5352     }
5353 }
5354
5355 proc incrfont {inc} {
5356     global mainfont textfont ctext canv phase cflist
5357     global charspc tabstop
5358     global stopped entries
5359     unmarkmatches
5360     set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
5361     set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
5362     setcoords
5363     $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]"
5364     $cflist conf -font $textfont
5365     $ctext tag conf filesep -font [concat $textfont bold]
5366     foreach e $entries {
5367         $e conf -font $mainfont
5368     }
5369     if {$phase eq "getcommits"} {
5370         $canv itemconf textitems -font $mainfont
5371     }
5372     redisplay
5373 }
5374
5375 proc clearsha1 {} {
5376     global sha1entry sha1string
5377     if {[string length $sha1string] == 40} {
5378         $sha1entry delete 0 end
5379     }
5380 }
5381
5382 proc sha1change {n1 n2 op} {
5383     global sha1string currentid sha1but
5384     if {$sha1string == {}
5385         || ([info exists currentid] && $sha1string == $currentid)} {
5386         set state disabled
5387     } else {
5388         set state normal
5389     }
5390     if {[$sha1but cget -state] == $state} return
5391     if {$state == "normal"} {
5392         $sha1but conf -state normal -relief raised -text "Goto: "
5393     } else {
5394         $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
5395     }
5396 }
5397
5398 proc gotocommit {} {
5399     global sha1string currentid commitrow tagids headids
5400     global displayorder numcommits curview
5401
5402     if {$sha1string == {}
5403         || ([info exists currentid] && $sha1string == $currentid)} return
5404     if {[info exists tagids($sha1string)]} {
5405         set id $tagids($sha1string)
5406     } elseif {[info exists headids($sha1string)]} {
5407         set id $headids($sha1string)
5408     } else {
5409         set id [string tolower $sha1string]
5410         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5411             set matches {}
5412             foreach i $displayorder {
5413                 if {[string match $id* $i]} {
5414                     lappend matches $i
5415                 }
5416             }
5417             if {$matches ne {}} {
5418                 if {[llength $matches] > 1} {
5419                     error_popup "Short SHA1 id $id is ambiguous"
5420                     return
5421                 }
5422                 set id [lindex $matches 0]
5423             }
5424         }
5425     }
5426     if {[info exists commitrow($curview,$id)]} {
5427         selectline $commitrow($curview,$id) 1
5428         return
5429     }
5430     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5431         set type "SHA1 id"
5432     } else {
5433         set type "Tag/Head"
5434     }
5435     error_popup "$type $sha1string is not known"
5436 }
5437
5438 proc lineenter {x y id} {
5439     global hoverx hovery hoverid hovertimer
5440     global commitinfo canv
5441
5442     if {![info exists commitinfo($id)] && ![getcommit $id]} return
5443     set hoverx $x
5444     set hovery $y
5445     set hoverid $id
5446     if {[info exists hovertimer]} {
5447         after cancel $hovertimer
5448     }
5449     set hovertimer [after 500 linehover]
5450     $canv delete hover
5451 }
5452
5453 proc linemotion {x y id} {
5454     global hoverx hovery hoverid hovertimer
5455
5456     if {[info exists hoverid] && $id == $hoverid} {
5457         set hoverx $x
5458         set hovery $y
5459         if {[info exists hovertimer]} {
5460             after cancel $hovertimer
5461         }
5462         set hovertimer [after 500 linehover]
5463     }
5464 }
5465
5466 proc lineleave {id} {
5467     global hoverid hovertimer canv
5468
5469     if {[info exists hoverid] && $id == $hoverid} {
5470         $canv delete hover
5471         if {[info exists hovertimer]} {
5472             after cancel $hovertimer
5473             unset hovertimer
5474         }
5475         unset hoverid
5476     }
5477 }
5478
5479 proc linehover {} {
5480     global hoverx hovery hoverid hovertimer
5481     global canv linespc lthickness
5482     global commitinfo mainfont
5483
5484     set text [lindex $commitinfo($hoverid) 0]
5485     set ymax [lindex [$canv cget -scrollregion] 3]
5486     if {$ymax == {}} return
5487     set yfrac [lindex [$canv yview] 0]
5488     set x [expr {$hoverx + 2 * $linespc}]
5489     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5490     set x0 [expr {$x - 2 * $lthickness}]
5491     set y0 [expr {$y - 2 * $lthickness}]
5492     set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
5493     set y1 [expr {$y + $linespc + 2 * $lthickness}]
5494     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5495                -fill \#ffff80 -outline black -width 1 -tags hover]
5496     $canv raise $t
5497     set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5498                -font $mainfont]
5499     $canv raise $t
5500 }
5501
5502 proc clickisonarrow {id y} {
5503     global lthickness
5504
5505     set ranges [rowranges $id]
5506     set thresh [expr {2 * $lthickness + 6}]
5507     set n [expr {[llength $ranges] - 1}]
5508     for {set i 1} {$i < $n} {incr i} {
5509         set row [lindex $ranges $i]
5510         if {abs([yc $row] - $y) < $thresh} {
5511             return $i
5512         }
5513     }
5514     return {}
5515 }
5516
5517 proc arrowjump {id n y} {
5518     global canv
5519
5520     # 1 <-> 2, 3 <-> 4, etc...
5521     set n [expr {(($n - 1) ^ 1) + 1}]
5522     set row [lindex [rowranges $id] $n]
5523     set yt [yc $row]
5524     set ymax [lindex [$canv cget -scrollregion] 3]
5525     if {$ymax eq {} || $ymax <= 0} return
5526     set view [$canv yview]
5527     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5528     set yfrac [expr {$yt / $ymax - $yspan / 2}]
5529     if {$yfrac < 0} {
5530         set yfrac 0
5531     }
5532     allcanvs yview moveto $yfrac
5533 }
5534
5535 proc lineclick {x y id isnew} {
5536     global ctext commitinfo children canv thickerline curview
5537
5538     if {![info exists commitinfo($id)] && ![getcommit $id]} return
5539     unmarkmatches
5540     unselectline
5541     normalline
5542     $canv delete hover
5543     # draw this line thicker than normal
5544     set thickerline $id
5545     drawlines $id
5546     if {$isnew} {
5547         set ymax [lindex [$canv cget -scrollregion] 3]
5548         if {$ymax eq {}} return
5549         set yfrac [lindex [$canv yview] 0]
5550         set y [expr {$y + $yfrac * $ymax}]
5551     }
5552     set dirn [clickisonarrow $id $y]
5553     if {$dirn ne {}} {
5554         arrowjump $id $dirn $y
5555         return
5556     }
5557
5558     if {$isnew} {
5559         addtohistory [list lineclick $x $y $id 0]
5560     }
5561     # fill the details pane with info about this line
5562     $ctext conf -state normal
5563     clear_ctext
5564     $ctext tag conf link -foreground blue -underline 1
5565     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5566     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5567     $ctext insert end "Parent:\t"
5568     $ctext insert end $id [list link link0]
5569     $ctext tag bind link0 <1> [list selbyid $id]
5570     set info $commitinfo($id)
5571     $ctext insert end "\n\t[lindex $info 0]\n"
5572     $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
5573     set date [formatdate [lindex $info 2]]
5574     $ctext insert end "\tDate:\t$date\n"
5575     set kids $children($curview,$id)
5576     if {$kids ne {}} {
5577         $ctext insert end "\nChildren:"
5578         set i 0
5579         foreach child $kids {
5580             incr i
5581             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5582             set info $commitinfo($child)
5583             $ctext insert end "\n\t"
5584             $ctext insert end $child [list link link$i]
5585             $ctext tag bind link$i <1> [list selbyid $child]
5586             $ctext insert end "\n\t[lindex $info 0]"
5587             $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
5588             set date [formatdate [lindex $info 2]]
5589             $ctext insert end "\n\tDate:\t$date\n"
5590         }
5591     }
5592     $ctext conf -state disabled
5593     init_flist {}
5594 }
5595
5596 proc normalline {} {
5597     global thickerline
5598     if {[info exists thickerline]} {
5599         set id $thickerline
5600         unset thickerline
5601         drawlines $id
5602     }
5603 }
5604
5605 proc selbyid {id} {
5606     global commitrow curview
5607     if {[info exists commitrow($curview,$id)]} {
5608         selectline $commitrow($curview,$id) 1
5609     }
5610 }
5611
5612 proc mstime {} {
5613     global startmstime
5614     if {![info exists startmstime]} {
5615         set startmstime [clock clicks -milliseconds]
5616     }
5617     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5618 }
5619
5620 proc rowmenu {x y id} {
5621     global rowctxmenu commitrow selectedline rowmenuid curview
5622     global nullid nullid2 fakerowmenu mainhead
5623
5624     set rowmenuid $id
5625     if {![info exists selectedline]
5626         || $commitrow($curview,$id) eq $selectedline} {
5627         set state disabled
5628     } else {
5629         set state normal
5630     }
5631     if {$id ne $nullid && $id ne $nullid2} {
5632         set menu $rowctxmenu
5633         $menu entryconfigure 7 -label "Reset $mainhead branch to here"
5634     } else {
5635         set menu $fakerowmenu
5636     }
5637     $menu entryconfigure "Diff this*" -state $state
5638     $menu entryconfigure "Diff selected*" -state $state
5639     $menu entryconfigure "Make patch" -state $state
5640     tk_popup $menu $x $y
5641 }
5642
5643 proc diffvssel {dirn} {
5644     global rowmenuid selectedline displayorder
5645
5646     if {![info exists selectedline]} return
5647     if {$dirn} {
5648         set oldid [lindex $displayorder $selectedline]
5649         set newid $rowmenuid
5650     } else {
5651         set oldid $rowmenuid
5652         set newid [lindex $displayorder $selectedline]
5653     }
5654     addtohistory [list doseldiff $oldid $newid]
5655     doseldiff $oldid $newid
5656 }
5657
5658 proc doseldiff {oldid newid} {
5659     global ctext
5660     global commitinfo
5661
5662     $ctext conf -state normal
5663     clear_ctext
5664     init_flist "Top"
5665     $ctext insert end "From "
5666     $ctext tag conf link -foreground blue -underline 1
5667     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5668     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5669     $ctext tag bind link0 <1> [list selbyid $oldid]
5670     $ctext insert end $oldid [list link link0]
5671     $ctext insert end "\n     "
5672     $ctext insert end [lindex $commitinfo($oldid) 0]
5673     $ctext insert end "\n\nTo   "
5674     $ctext tag bind link1 <1> [list selbyid $newid]
5675     $ctext insert end $newid [list link link1]
5676     $ctext insert end "\n     "
5677     $ctext insert end [lindex $commitinfo($newid) 0]
5678     $ctext insert end "\n"
5679     $ctext conf -state disabled
5680     $ctext tag remove found 1.0 end
5681     startdiff [list $oldid $newid]
5682 }
5683
5684 proc mkpatch {} {
5685     global rowmenuid currentid commitinfo patchtop patchnum
5686
5687     if {![info exists currentid]} return
5688     set oldid $currentid
5689     set oldhead [lindex $commitinfo($oldid) 0]
5690     set newid $rowmenuid
5691     set newhead [lindex $commitinfo($newid) 0]
5692     set top .patch
5693     set patchtop $top
5694     catch {destroy $top}
5695     toplevel $top
5696     label $top.title -text "Generate patch"
5697     grid $top.title - -pady 10
5698     label $top.from -text "From:"
5699     entry $top.fromsha1 -width 40 -relief flat
5700     $top.fromsha1 insert 0 $oldid
5701     $top.fromsha1 conf -state readonly
5702     grid $top.from $top.fromsha1 -sticky w
5703     entry $top.fromhead -width 60 -relief flat
5704     $top.fromhead insert 0 $oldhead
5705     $top.fromhead conf -state readonly
5706     grid x $top.fromhead -sticky w
5707     label $top.to -text "To:"
5708     entry $top.tosha1 -width 40 -relief flat
5709     $top.tosha1 insert 0 $newid
5710     $top.tosha1 conf -state readonly
5711     grid $top.to $top.tosha1 -sticky w
5712     entry $top.tohead -width 60 -relief flat
5713     $top.tohead insert 0 $newhead
5714     $top.tohead conf -state readonly
5715     grid x $top.tohead -sticky w
5716     button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5717     grid $top.rev x -pady 10
5718     label $top.flab -text "Output file:"
5719     entry $top.fname -width 60
5720     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5721     incr patchnum
5722     grid $top.flab $top.fname -sticky w
5723     frame $top.buts
5724     button $top.buts.gen -text "Generate" -command mkpatchgo
5725     button $top.buts.can -text "Cancel" -command mkpatchcan
5726     grid $top.buts.gen $top.buts.can
5727     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5728     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5729     grid $top.buts - -pady 10 -sticky ew
5730     focus $top.fname
5731 }
5732
5733 proc mkpatchrev {} {
5734     global patchtop
5735
5736     set oldid [$patchtop.fromsha1 get]
5737     set oldhead [$patchtop.fromhead get]
5738     set newid [$patchtop.tosha1 get]
5739     set newhead [$patchtop.tohead get]
5740     foreach e [list fromsha1 fromhead tosha1 tohead] \
5741             v [list $newid $newhead $oldid $oldhead] {
5742         $patchtop.$e conf -state normal
5743         $patchtop.$e delete 0 end
5744         $patchtop.$e insert 0 $v
5745         $patchtop.$e conf -state readonly
5746     }
5747 }
5748
5749 proc mkpatchgo {} {
5750     global patchtop nullid nullid2
5751
5752     set oldid [$patchtop.fromsha1 get]
5753     set newid [$patchtop.tosha1 get]
5754     set fname [$patchtop.fname get]
5755     set cmd [diffcmd [list $oldid $newid] -p]
5756     lappend cmd >$fname &
5757     if {[catch {eval exec $cmd} err]} {
5758         error_popup "Error creating patch: $err"
5759     }
5760     catch {destroy $patchtop}
5761     unset patchtop
5762 }
5763
5764 proc mkpatchcan {} {
5765     global patchtop
5766
5767     catch {destroy $patchtop}
5768     unset patchtop
5769 }
5770
5771 proc mktag {} {
5772     global rowmenuid mktagtop commitinfo
5773
5774     set top .maketag
5775     set mktagtop $top
5776     catch {destroy $top}
5777     toplevel $top
5778     label $top.title -text "Create tag"
5779     grid $top.title - -pady 10
5780     label $top.id -text "ID:"
5781     entry $top.sha1 -width 40 -relief flat
5782     $top.sha1 insert 0 $rowmenuid
5783     $top.sha1 conf -state readonly
5784     grid $top.id $top.sha1 -sticky w
5785     entry $top.head -width 60 -relief flat
5786     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5787     $top.head conf -state readonly
5788     grid x $top.head -sticky w
5789     label $top.tlab -text "Tag name:"
5790     entry $top.tag -width 60
5791     grid $top.tlab $top.tag -sticky w
5792     frame $top.buts
5793     button $top.buts.gen -text "Create" -command mktaggo
5794     button $top.buts.can -text "Cancel" -command mktagcan
5795     grid $top.buts.gen $top.buts.can
5796     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5797     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5798     grid $top.buts - -pady 10 -sticky ew
5799     focus $top.tag
5800 }
5801
5802 proc domktag {} {
5803     global mktagtop env tagids idtags
5804
5805     set id [$mktagtop.sha1 get]
5806     set tag [$mktagtop.tag get]
5807     if {$tag == {}} {
5808         error_popup "No tag name specified"
5809         return
5810     }
5811     if {[info exists tagids($tag)]} {
5812         error_popup "Tag \"$tag\" already exists"
5813         return
5814     }
5815     if {[catch {
5816         set dir [gitdir]
5817         set fname [file join $dir "refs/tags" $tag]
5818         set f [open $fname w]
5819         puts $f $id
5820         close $f
5821     } err]} {
5822         error_popup "Error creating tag: $err"
5823         return
5824     }
5825
5826     set tagids($tag) $id
5827     lappend idtags($id) $tag
5828     redrawtags $id
5829     addedtag $id
5830 }
5831
5832 proc redrawtags {id} {
5833     global canv linehtag commitrow idpos selectedline curview
5834     global mainfont canvxmax iddrawn
5835
5836     if {![info exists commitrow($curview,$id)]} return
5837     if {![info exists iddrawn($id)]} return
5838     drawcommits $commitrow($curview,$id)
5839     $canv delete tag.$id
5840     set xt [eval drawtags $id $idpos($id)]
5841     $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5842     set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5843     set xr [expr {$xt + [font measure $mainfont $text]}]
5844     if {$xr > $canvxmax} {
5845         set canvxmax $xr
5846         setcanvscroll
5847     }
5848     if {[info exists selectedline]
5849         && $selectedline == $commitrow($curview,$id)} {
5850         selectline $selectedline 0
5851     }
5852 }
5853
5854 proc mktagcan {} {
5855     global mktagtop
5856
5857     catch {destroy $mktagtop}
5858     unset mktagtop
5859 }
5860
5861 proc mktaggo {} {
5862     domktag
5863     mktagcan
5864 }
5865
5866 proc writecommit {} {
5867     global rowmenuid wrcomtop commitinfo wrcomcmd
5868
5869     set top .writecommit
5870     set wrcomtop $top
5871     catch {destroy $top}
5872     toplevel $top
5873     label $top.title -text "Write commit to file"
5874     grid $top.title - -pady 10
5875     label $top.id -text "ID:"
5876     entry $top.sha1 -width 40 -relief flat
5877     $top.sha1 insert 0 $rowmenuid
5878     $top.sha1 conf -state readonly
5879     grid $top.id $top.sha1 -sticky w
5880     entry $top.head -width 60 -relief flat
5881     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5882     $top.head conf -state readonly
5883     grid x $top.head -sticky w
5884     label $top.clab -text "Command:"
5885     entry $top.cmd -width 60 -textvariable wrcomcmd
5886     grid $top.clab $top.cmd -sticky w -pady 10
5887     label $top.flab -text "Output file:"
5888     entry $top.fname -width 60
5889     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5890     grid $top.flab $top.fname -sticky w
5891     frame $top.buts
5892     button $top.buts.gen -text "Write" -command wrcomgo
5893     button $top.buts.can -text "Cancel" -command wrcomcan
5894     grid $top.buts.gen $top.buts.can
5895     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5896     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5897     grid $top.buts - -pady 10 -sticky ew
5898     focus $top.fname
5899 }
5900
5901 proc wrcomgo {} {
5902     global wrcomtop
5903
5904     set id [$wrcomtop.sha1 get]
5905     set cmd "echo $id | [$wrcomtop.cmd get]"
5906     set fname [$wrcomtop.fname get]
5907     if {[catch {exec sh -c $cmd >$fname &} err]} {
5908         error_popup "Error writing commit: $err"
5909     }
5910     catch {destroy $wrcomtop}
5911     unset wrcomtop
5912 }
5913
5914 proc wrcomcan {} {
5915     global wrcomtop
5916
5917     catch {destroy $wrcomtop}
5918     unset wrcomtop
5919 }
5920
5921 proc mkbranch {} {
5922     global rowmenuid mkbrtop
5923
5924     set top .makebranch
5925     catch {destroy $top}
5926     toplevel $top
5927     label $top.title -text "Create new branch"
5928     grid $top.title - -pady 10
5929     label $top.id -text "ID:"
5930     entry $top.sha1 -width 40 -relief flat
5931     $top.sha1 insert 0 $rowmenuid
5932     $top.sha1 conf -state readonly
5933     grid $top.id $top.sha1 -sticky w
5934     label $top.nlab -text "Name:"
5935     entry $top.name -width 40
5936     grid $top.nlab $top.name -sticky w
5937     frame $top.buts
5938     button $top.buts.go -text "Create" -command [list mkbrgo $top]
5939     button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5940     grid $top.buts.go $top.buts.can
5941     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5942     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5943     grid $top.buts - -pady 10 -sticky ew
5944     focus $top.name
5945 }
5946
5947 proc mkbrgo {top} {
5948     global headids idheads
5949
5950     set name [$top.name get]
5951     set id [$top.sha1 get]
5952     if {$name eq {}} {
5953         error_popup "Please specify a name for the new branch"
5954         return
5955     }
5956     catch {destroy $top}
5957     nowbusy newbranch
5958     update
5959     if {[catch {
5960         exec git branch $name $id
5961     } err]} {
5962         notbusy newbranch
5963         error_popup $err
5964     } else {
5965         set headids($name) $id
5966         lappend idheads($id) $name
5967         addedhead $id $name
5968         notbusy newbranch
5969         redrawtags $id
5970         dispneartags 0
5971     }
5972 }
5973
5974 proc cherrypick {} {
5975     global rowmenuid curview commitrow
5976     global mainhead
5977
5978     set oldhead [exec git rev-parse HEAD]
5979     set dheads [descheads $rowmenuid]
5980     if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
5981         set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
5982                         included in branch $mainhead -- really re-apply it?"]
5983         if {!$ok} return
5984     }
5985     nowbusy cherrypick
5986     update
5987     # Unfortunately git-cherry-pick writes stuff to stderr even when
5988     # no error occurs, and exec takes that as an indication of error...
5989     if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
5990         notbusy cherrypick
5991         error_popup $err
5992         return
5993     }
5994     set newhead [exec git rev-parse HEAD]
5995     if {$newhead eq $oldhead} {
5996         notbusy cherrypick
5997         error_popup "No changes committed"
5998         return
5999     }
6000     addnewchild $newhead $oldhead
6001     if {[info exists commitrow($curview,$oldhead)]} {
6002         insertrow $commitrow($curview,$oldhead) $newhead
6003         if {$mainhead ne {}} {
6004             movehead $newhead $mainhead
6005             movedhead $newhead $mainhead
6006         }
6007         redrawtags $oldhead
6008         redrawtags $newhead
6009     }
6010     notbusy cherrypick
6011 }
6012
6013 proc resethead {} {
6014     global mainheadid mainhead rowmenuid confirm_ok resettype
6015     global showlocalchanges
6016
6017     set confirm_ok 0
6018     set w ".confirmreset"
6019     toplevel $w
6020     wm transient $w .
6021     wm title $w "Confirm reset"
6022     message $w.m -text \
6023         "Reset branch $mainhead to [string range $rowmenuid 0 7]?" \
6024         -justify center -aspect 1000
6025     pack $w.m -side top -fill x -padx 20 -pady 20
6026     frame $w.f -relief sunken -border 2
6027     message $w.f.rt -text "Reset type:" -aspect 1000
6028     grid $w.f.rt -sticky w
6029     set resettype mixed
6030     radiobutton $w.f.soft -value soft -variable resettype -justify left \
6031         -text "Soft: Leave working tree and index untouched"
6032     grid $w.f.soft -sticky w
6033     radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
6034         -text "Mixed: Leave working tree untouched, reset index"
6035     grid $w.f.mixed -sticky w
6036     radiobutton $w.f.hard -value hard -variable resettype -justify left \
6037         -text "Hard: Reset working tree and index\n(discard ALL local changes)"
6038     grid $w.f.hard -sticky w
6039     pack $w.f -side top -fill x
6040     button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
6041     pack $w.ok -side left -fill x -padx 20 -pady 20
6042     button $w.cancel -text Cancel -command "destroy $w"
6043     pack $w.cancel -side right -fill x -padx 20 -pady 20
6044     bind $w <Visibility> "grab $w; focus $w"
6045     tkwait window $w
6046     if {!$confirm_ok} return
6047     if {[catch {set fd [open \
6048             [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6049         error_popup $err
6050     } else {
6051         dohidelocalchanges
6052         set w ".resetprogress"
6053         filerun $fd [list readresetstat $fd $w]
6054         toplevel $w
6055         wm transient $w
6056         wm title $w "Reset progress"
6057         message $w.m -text "Reset in progress, please wait..." \
6058             -justify center -aspect 1000
6059         pack $w.m -side top -fill x -padx 20 -pady 5
6060         canvas $w.c -width 150 -height 20 -bg white
6061         $w.c create rect 0 0 0 20 -fill green -tags rect
6062         pack $w.c -side top -fill x -padx 20 -pady 5 -expand 1
6063         nowbusy reset
6064     }
6065 }
6066
6067 proc readresetstat {fd w} {
6068     global mainhead mainheadid showlocalchanges
6069
6070     if {[gets $fd line] >= 0} {
6071         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
6072             set x [expr {($m * 150) / $n}]
6073             $w.c coords rect 0 0 $x 20
6074         }
6075         return 1
6076     }
6077     destroy $w
6078     notbusy reset
6079     if {[catch {close $fd} err]} {
6080         error_popup $err
6081     }
6082     set oldhead $mainheadid
6083     set newhead [exec git rev-parse HEAD]
6084     if {$newhead ne $oldhead} {
6085         movehead $newhead $mainhead
6086         movedhead $newhead $mainhead
6087         set mainheadid $newhead
6088         redrawtags $oldhead
6089         redrawtags $newhead
6090     }
6091     if {$showlocalchanges} {
6092         doshowlocalchanges
6093     }
6094     return 0
6095 }
6096
6097 # context menu for a head
6098 proc headmenu {x y id head} {
6099     global headmenuid headmenuhead headctxmenu mainhead
6100
6101     set headmenuid $id
6102     set headmenuhead $head
6103     set state normal
6104     if {$head eq $mainhead} {
6105         set state disabled
6106     }
6107     $headctxmenu entryconfigure 0 -state $state
6108     $headctxmenu entryconfigure 1 -state $state
6109     tk_popup $headctxmenu $x $y
6110 }
6111
6112 proc cobranch {} {
6113     global headmenuid headmenuhead mainhead headids
6114     global showlocalchanges mainheadid
6115
6116     # check the tree is clean first??
6117     set oldmainhead $mainhead
6118     nowbusy checkout
6119     update
6120     dohidelocalchanges
6121     if {[catch {
6122         exec git checkout -q $headmenuhead
6123     } err]} {
6124         notbusy checkout
6125         error_popup $err
6126     } else {
6127         notbusy checkout
6128         set mainhead $headmenuhead
6129         set mainheadid $headmenuid
6130         if {[info exists headids($oldmainhead)]} {
6131             redrawtags $headids($oldmainhead)
6132         }
6133         redrawtags $headmenuid
6134     }
6135     if {$showlocalchanges} {
6136         dodiffindex
6137     }
6138 }
6139
6140 proc rmbranch {} {
6141     global headmenuid headmenuhead mainhead
6142     global headids idheads
6143
6144     set head $headmenuhead
6145     set id $headmenuid
6146     # this check shouldn't be needed any more...
6147     if {$head eq $mainhead} {
6148         error_popup "Cannot delete the currently checked-out branch"
6149         return
6150     }
6151     set dheads [descheads $id]
6152     if {$dheads eq $headids($head)} {
6153         # the stuff on this branch isn't on any other branch
6154         if {![confirm_popup "The commits on branch $head aren't on any other\
6155                         branch.\nReally delete branch $head?"]} return
6156     }
6157     nowbusy rmbranch
6158     update
6159     if {[catch {exec git branch -D $head} err]} {
6160         notbusy rmbranch
6161         error_popup $err
6162         return
6163     }
6164     removehead $id $head
6165     removedhead $id $head
6166     redrawtags $id
6167     notbusy rmbranch
6168     dispneartags 0
6169 }
6170
6171 # Stuff for finding nearby tags
6172 proc getallcommits {} {
6173     global allcommits allids nbmp nextarc seeds
6174
6175     set allids {}
6176     set nbmp 0
6177     set nextarc 0
6178     set allcommits 0
6179     set seeds {}
6180     regetallcommits
6181 }
6182
6183 # Called when the graph might have changed
6184 proc regetallcommits {} {
6185     global allcommits seeds
6186
6187     set cmd [concat | git rev-list --all --parents]
6188     foreach id $seeds {
6189         lappend cmd "^$id"
6190     }
6191     set fd [open $cmd r]
6192     fconfigure $fd -blocking 0
6193     incr allcommits
6194     nowbusy allcommits
6195     filerun $fd [list getallclines $fd]
6196 }
6197
6198 # Since most commits have 1 parent and 1 child, we group strings of
6199 # such commits into "arcs" joining branch/merge points (BMPs), which
6200 # are commits that either don't have 1 parent or don't have 1 child.
6201 #
6202 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6203 # arcout(id) - outgoing arcs for BMP
6204 # arcids(a) - list of IDs on arc including end but not start
6205 # arcstart(a) - BMP ID at start of arc
6206 # arcend(a) - BMP ID at end of arc
6207 # growing(a) - arc a is still growing
6208 # arctags(a) - IDs out of arcids (excluding end) that have tags
6209 # archeads(a) - IDs out of arcids (excluding end) that have heads
6210 # The start of an arc is at the descendent end, so "incoming" means
6211 # coming from descendents, and "outgoing" means going towards ancestors.
6212
6213 proc getallclines {fd} {
6214     global allids allparents allchildren idtags idheads nextarc nbmp
6215     global arcnos arcids arctags arcout arcend arcstart archeads growing
6216     global seeds allcommits
6217
6218     set nid 0
6219     while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6220         set id [lindex $line 0]
6221         if {[info exists allparents($id)]} {
6222             # seen it already
6223             continue
6224         }
6225         lappend allids $id
6226         set olds [lrange $line 1 end]
6227         set allparents($id) $olds
6228         if {![info exists allchildren($id)]} {
6229             set allchildren($id) {}
6230             set arcnos($id) {}
6231             lappend seeds $id
6232         } else {
6233             set a $arcnos($id)
6234             if {[llength $olds] == 1 && [llength $a] == 1} {
6235                 lappend arcids($a) $id
6236                 if {[info exists idtags($id)]} {
6237                     lappend arctags($a) $id
6238                 }
6239                 if {[info exists idheads($id)]} {
6240                     lappend archeads($a) $id
6241                 }
6242                 if {[info exists allparents($olds)]} {
6243                     # seen parent already
6244                     if {![info exists arcout($olds)]} {
6245                         splitarc $olds
6246                     }
6247                     lappend arcids($a) $olds
6248                     set arcend($a) $olds
6249                     unset growing($a)
6250                 }
6251                 lappend allchildren($olds) $id
6252                 lappend arcnos($olds) $a
6253                 continue
6254             }
6255         }
6256         incr nbmp
6257         foreach a $arcnos($id) {
6258             lappend arcids($a) $id
6259             set arcend($a) $id
6260             unset growing($a)
6261         }
6262
6263         set ao {}
6264         foreach p $olds {
6265             lappend allchildren($p) $id
6266             set a [incr nextarc]
6267             set arcstart($a) $id
6268             set archeads($a) {}
6269             set arctags($a) {}
6270             set archeads($a) {}
6271             set arcids($a) {}
6272             lappend ao $a
6273             set growing($a) 1
6274             if {[info exists allparents($p)]} {
6275                 # seen it already, may need to make a new branch
6276                 if {![info exists arcout($p)]} {
6277                     splitarc $p
6278                 }
6279                 lappend arcids($a) $p
6280                 set arcend($a) $p
6281                 unset growing($a)
6282             }
6283             lappend arcnos($p) $a
6284         }
6285         set arcout($id) $ao
6286     }
6287     if {$nid > 0} {
6288         global cached_dheads cached_dtags cached_atags
6289         catch {unset cached_dheads}
6290         catch {unset cached_dtags}
6291         catch {unset cached_atags}
6292     }
6293     if {![eof $fd]} {
6294         return [expr {$nid >= 1000? 2: 1}]
6295     }
6296     close $fd
6297     if {[incr allcommits -1] == 0} {
6298         notbusy allcommits
6299     }
6300     dispneartags 0
6301     return 0
6302 }
6303
6304 proc recalcarc {a} {
6305     global arctags archeads arcids idtags idheads
6306
6307     set at {}
6308     set ah {}
6309     foreach id [lrange $arcids($a) 0 end-1] {
6310         if {[info exists idtags($id)]} {
6311             lappend at $id
6312         }
6313         if {[info exists idheads($id)]} {
6314             lappend ah $id
6315         }
6316     }
6317     set arctags($a) $at
6318     set archeads($a) $ah
6319 }
6320
6321 proc splitarc {p} {
6322     global arcnos arcids nextarc nbmp arctags archeads idtags idheads
6323     global arcstart arcend arcout allparents growing
6324
6325     set a $arcnos($p)
6326     if {[llength $a] != 1} {
6327         puts "oops splitarc called but [llength $a] arcs already"
6328         return
6329     }
6330     set a [lindex $a 0]
6331     set i [lsearch -exact $arcids($a) $p]
6332     if {$i < 0} {
6333         puts "oops splitarc $p not in arc $a"
6334         return
6335     }
6336     set na [incr nextarc]
6337     if {[info exists arcend($a)]} {
6338         set arcend($na) $arcend($a)
6339     } else {
6340         set l [lindex $allparents([lindex $arcids($a) end]) 0]
6341         set j [lsearch -exact $arcnos($l) $a]
6342         set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6343     }
6344     set tail [lrange $arcids($a) [expr {$i+1}] end]
6345     set arcids($a) [lrange $arcids($a) 0 $i]
6346     set arcend($a) $p
6347     set arcstart($na) $p
6348     set arcout($p) $na
6349     set arcids($na) $tail
6350     if {[info exists growing($a)]} {
6351         set growing($na) 1
6352         unset growing($a)
6353     }
6354     incr nbmp
6355
6356     foreach id $tail {
6357         if {[llength $arcnos($id)] == 1} {
6358             set arcnos($id) $na
6359         } else {
6360             set j [lsearch -exact $arcnos($id) $a]
6361             set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6362         }
6363     }
6364
6365     # reconstruct tags and heads lists
6366     if {$arctags($a) ne {} || $archeads($a) ne {}} {
6367         recalcarc $a
6368         recalcarc $na
6369     } else {
6370         set arctags($na) {}
6371         set archeads($na) {}
6372     }
6373 }
6374
6375 # Update things for a new commit added that is a child of one
6376 # existing commit.  Used when cherry-picking.
6377 proc addnewchild {id p} {
6378     global allids allparents allchildren idtags nextarc nbmp
6379     global arcnos arcids arctags arcout arcend arcstart archeads growing
6380     global seeds
6381
6382     lappend allids $id
6383     set allparents($id) [list $p]
6384     set allchildren($id) {}
6385     set arcnos($id) {}
6386     lappend seeds $id
6387     incr nbmp
6388     lappend allchildren($p) $id
6389     set a [incr nextarc]
6390     set arcstart($a) $id
6391     set archeads($a) {}
6392     set arctags($a) {}
6393     set arcids($a) [list $p]
6394     set arcend($a) $p
6395     if {![info exists arcout($p)]} {
6396         splitarc $p
6397     }
6398     lappend arcnos($p) $a
6399     set arcout($id) [list $a]
6400 }
6401
6402 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
6403 # or 0 if neither is true.
6404 proc anc_or_desc {a b} {
6405     global arcout arcstart arcend arcnos cached_isanc
6406
6407     if {$arcnos($a) eq $arcnos($b)} {
6408         # Both are on the same arc(s); either both are the same BMP,
6409         # or if one is not a BMP, the other is also not a BMP or is
6410         # the BMP at end of the arc (and it only has 1 incoming arc).
6411         # Or both can be BMPs with no incoming arcs.
6412         if {$a eq $b || $arcnos($a) eq {}} {
6413             return 0
6414         }
6415         # assert {[llength $arcnos($a)] == 1}
6416         set arc [lindex $arcnos($a) 0]
6417         set i [lsearch -exact $arcids($arc) $a]
6418         set j [lsearch -exact $arcids($arc) $b]
6419         if {$i < 0 || $i > $j} {
6420             return 1
6421         } else {
6422             return -1
6423         }
6424     }
6425
6426     if {![info exists arcout($a)]} {
6427         set arc [lindex $arcnos($a) 0]
6428         if {[info exists arcend($arc)]} {
6429             set aend $arcend($arc)
6430         } else {
6431             set aend {}
6432         }
6433         set a $arcstart($arc)
6434     } else {
6435         set aend $a
6436     }
6437     if {![info exists arcout($b)]} {
6438         set arc [lindex $arcnos($b) 0]
6439         if {[info exists arcend($arc)]} {
6440             set bend $arcend($arc)
6441         } else {
6442             set bend {}
6443         }
6444         set b $arcstart($arc)
6445     } else {
6446         set bend $b
6447     }
6448     if {$a eq $bend} {
6449         return 1
6450     }
6451     if {$b eq $aend} {
6452         return -1
6453     }
6454     if {[info exists cached_isanc($a,$bend)]} {
6455         if {$cached_isanc($a,$bend)} {
6456             return 1
6457         }
6458     }
6459     if {[info exists cached_isanc($b,$aend)]} {
6460         if {$cached_isanc($b,$aend)} {
6461             return -1
6462         }
6463         if {[info exists cached_isanc($a,$bend)]} {
6464             return 0
6465         }
6466     }
6467
6468     set todo [list $a $b]
6469     set anc($a) a
6470     set anc($b) b
6471     for {set i 0} {$i < [llength $todo]} {incr i} {
6472         set x [lindex $todo $i]
6473         if {$anc($x) eq {}} {
6474             continue
6475         }
6476         foreach arc $arcnos($x) {
6477             set xd $arcstart($arc)
6478             if {$xd eq $bend} {
6479                 set cached_isanc($a,$bend) 1
6480                 set cached_isanc($b,$aend) 0
6481                 return 1
6482             } elseif {$xd eq $aend} {
6483                 set cached_isanc($b,$aend) 1
6484                 set cached_isanc($a,$bend) 0
6485                 return -1
6486             }
6487             if {![info exists anc($xd)]} {
6488                 set anc($xd) $anc($x)
6489                 lappend todo $xd
6490             } elseif {$anc($xd) ne $anc($x)} {
6491                 set anc($xd) {}
6492             }
6493         }
6494     }
6495     set cached_isanc($a,$bend) 0
6496     set cached_isanc($b,$aend) 0
6497     return 0
6498 }
6499
6500 # This identifies whether $desc has an ancestor that is
6501 # a growing tip of the graph and which is not an ancestor of $anc
6502 # and returns 0 if so and 1 if not.
6503 # If we subsequently discover a tag on such a growing tip, and that
6504 # turns out to be a descendent of $anc (which it could, since we
6505 # don't necessarily see children before parents), then $desc
6506 # isn't a good choice to display as a descendent tag of
6507 # $anc (since it is the descendent of another tag which is
6508 # a descendent of $anc).  Similarly, $anc isn't a good choice to
6509 # display as a ancestor tag of $desc.
6510 #
6511 proc is_certain {desc anc} {
6512     global arcnos arcout arcstart arcend growing problems
6513
6514     set certain {}
6515     if {[llength $arcnos($anc)] == 1} {
6516         # tags on the same arc are certain
6517         if {$arcnos($desc) eq $arcnos($anc)} {
6518             return 1
6519         }
6520         if {![info exists arcout($anc)]} {
6521             # if $anc is partway along an arc, use the start of the arc instead
6522             set a [lindex $arcnos($anc) 0]
6523             set anc $arcstart($a)
6524         }
6525     }
6526     if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
6527         set x $desc
6528     } else {
6529         set a [lindex $arcnos($desc) 0]
6530         set x $arcend($a)
6531     }
6532     if {$x == $anc} {
6533         return 1
6534     }
6535     set anclist [list $x]
6536     set dl($x) 1
6537     set nnh 1
6538     set ngrowanc 0
6539     for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
6540         set x [lindex $anclist $i]
6541         if {$dl($x)} {
6542             incr nnh -1
6543         }
6544         set done($x) 1
6545         foreach a $arcout($x) {
6546             if {[info exists growing($a)]} {
6547                 if {![info exists growanc($x)] && $dl($x)} {
6548                     set growanc($x) 1
6549                     incr ngrowanc
6550                 }
6551             } else {
6552                 set y $arcend($a)
6553                 if {[info exists dl($y)]} {
6554                     if {$dl($y)} {
6555                         if {!$dl($x)} {
6556                             set dl($y) 0
6557                             if {![info exists done($y)]} {
6558                                 incr nnh -1
6559                             }
6560                             if {[info exists growanc($x)]} {
6561                                 incr ngrowanc -1
6562                             }
6563                             set xl [list $y]
6564                             for {set k 0} {$k < [llength $xl]} {incr k} {
6565                                 set z [lindex $xl $k]
6566                                 foreach c $arcout($z) {
6567                                     if {[info exists arcend($c)]} {
6568                                         set v $arcend($c)
6569                                         if {[info exists dl($v)] && $dl($v)} {
6570                                             set dl($v) 0
6571                                             if {![info exists done($v)]} {
6572                                                 incr nnh -1
6573                                             }
6574                                             if {[info exists growanc($v)]} {
6575                                                 incr ngrowanc -1
6576                                             }
6577                                             lappend xl $v
6578                                         }
6579                                     }
6580                                 }
6581                             }
6582                         }
6583                     }
6584                 } elseif {$y eq $anc || !$dl($x)} {
6585                     set dl($y) 0
6586                     lappend anclist $y
6587                 } else {
6588                     set dl($y) 1
6589                     lappend anclist $y
6590                     incr nnh
6591                 }
6592             }
6593         }
6594     }
6595     foreach x [array names growanc] {
6596         if {$dl($x)} {
6597             return 0
6598         }
6599         return 0
6600     }
6601     return 1
6602 }
6603
6604 proc validate_arctags {a} {
6605     global arctags idtags
6606
6607     set i -1
6608     set na $arctags($a)
6609     foreach id $arctags($a) {
6610         incr i
6611         if {![info exists idtags($id)]} {
6612             set na [lreplace $na $i $i]
6613             incr i -1
6614         }
6615     }
6616     set arctags($a) $na
6617 }
6618
6619 proc validate_archeads {a} {
6620     global archeads idheads
6621
6622     set i -1
6623     set na $archeads($a)
6624     foreach id $archeads($a) {
6625         incr i
6626         if {![info exists idheads($id)]} {
6627             set na [lreplace $na $i $i]
6628             incr i -1
6629         }
6630     }
6631     set archeads($a) $na
6632 }
6633
6634 # Return the list of IDs that have tags that are descendents of id,
6635 # ignoring IDs that are descendents of IDs already reported.
6636 proc desctags {id} {
6637     global arcnos arcstart arcids arctags idtags allparents
6638     global growing cached_dtags
6639
6640     if {![info exists allparents($id)]} {
6641         return {}
6642     }
6643     set t1 [clock clicks -milliseconds]
6644     set argid $id
6645     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6646         # part-way along an arc; check that arc first
6647         set a [lindex $arcnos($id) 0]
6648         if {$arctags($a) ne {}} {
6649             validate_arctags $a
6650             set i [lsearch -exact $arcids($a) $id]
6651             set tid {}
6652             foreach t $arctags($a) {
6653                 set j [lsearch -exact $arcids($a) $t]
6654                 if {$j >= $i} break
6655                 set tid $t
6656             }
6657             if {$tid ne {}} {
6658                 return $tid
6659             }
6660         }
6661         set id $arcstart($a)
6662         if {[info exists idtags($id)]} {
6663             return $id
6664         }
6665     }
6666     if {[info exists cached_dtags($id)]} {
6667         return $cached_dtags($id)
6668     }
6669
6670     set origid $id
6671     set todo [list $id]
6672     set queued($id) 1
6673     set nc 1
6674     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6675         set id [lindex $todo $i]
6676         set done($id) 1
6677         set ta [info exists hastaggedancestor($id)]
6678         if {!$ta} {
6679             incr nc -1
6680         }
6681         # ignore tags on starting node
6682         if {!$ta && $i > 0} {
6683             if {[info exists idtags($id)]} {
6684                 set tagloc($id) $id
6685                 set ta 1
6686             } elseif {[info exists cached_dtags($id)]} {
6687                 set tagloc($id) $cached_dtags($id)
6688                 set ta 1
6689             }
6690         }
6691         foreach a $arcnos($id) {
6692             set d $arcstart($a)
6693             if {!$ta && $arctags($a) ne {}} {
6694                 validate_arctags $a
6695                 if {$arctags($a) ne {}} {
6696                     lappend tagloc($id) [lindex $arctags($a) end]
6697                 }
6698             }
6699             if {$ta || $arctags($a) ne {}} {
6700                 set tomark [list $d]
6701                 for {set j 0} {$j < [llength $tomark]} {incr j} {
6702                     set dd [lindex $tomark $j]
6703                     if {![info exists hastaggedancestor($dd)]} {
6704                         if {[info exists done($dd)]} {
6705                             foreach b $arcnos($dd) {
6706                                 lappend tomark $arcstart($b)
6707                             }
6708                             if {[info exists tagloc($dd)]} {
6709                                 unset tagloc($dd)
6710                             }
6711                         } elseif {[info exists queued($dd)]} {
6712                             incr nc -1
6713                         }
6714                         set hastaggedancestor($dd) 1
6715                     }
6716                 }
6717             }
6718             if {![info exists queued($d)]} {
6719                 lappend todo $d
6720                 set queued($d) 1
6721                 if {![info exists hastaggedancestor($d)]} {
6722                     incr nc
6723                 }
6724             }
6725         }
6726     }
6727     set tags {}
6728     foreach id [array names tagloc] {
6729         if {![info exists hastaggedancestor($id)]} {
6730             foreach t $tagloc($id) {
6731                 if {[lsearch -exact $tags $t] < 0} {
6732                     lappend tags $t
6733                 }
6734             }
6735         }
6736     }
6737     set t2 [clock clicks -milliseconds]
6738     set loopix $i
6739
6740     # remove tags that are descendents of other tags
6741     for {set i 0} {$i < [llength $tags]} {incr i} {
6742         set a [lindex $tags $i]
6743         for {set j 0} {$j < $i} {incr j} {
6744             set b [lindex $tags $j]
6745             set r [anc_or_desc $a $b]
6746             if {$r == 1} {
6747                 set tags [lreplace $tags $j $j]
6748                 incr j -1
6749                 incr i -1
6750             } elseif {$r == -1} {
6751                 set tags [lreplace $tags $i $i]
6752                 incr i -1
6753                 break
6754             }
6755         }
6756     }
6757
6758     if {[array names growing] ne {}} {
6759         # graph isn't finished, need to check if any tag could get
6760         # eclipsed by another tag coming later.  Simply ignore any
6761         # tags that could later get eclipsed.
6762         set ctags {}
6763         foreach t $tags {
6764             if {[is_certain $t $origid]} {
6765                 lappend ctags $t
6766             }
6767         }
6768         if {$tags eq $ctags} {
6769             set cached_dtags($origid) $tags
6770         } else {
6771             set tags $ctags
6772         }
6773     } else {
6774         set cached_dtags($origid) $tags
6775     }
6776     set t3 [clock clicks -milliseconds]
6777     if {0 && $t3 - $t1 >= 100} {
6778         puts "iterating descendents ($loopix/[llength $todo] nodes) took\
6779             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
6780     }
6781     return $tags
6782 }
6783
6784 proc anctags {id} {
6785     global arcnos arcids arcout arcend arctags idtags allparents
6786     global growing cached_atags
6787
6788     if {![info exists allparents($id)]} {
6789         return {}
6790     }
6791     set t1 [clock clicks -milliseconds]
6792     set argid $id
6793     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6794         # part-way along an arc; check that arc first
6795         set a [lindex $arcnos($id) 0]
6796         if {$arctags($a) ne {}} {
6797             validate_arctags $a
6798             set i [lsearch -exact $arcids($a) $id]
6799             foreach t $arctags($a) {
6800                 set j [lsearch -exact $arcids($a) $t]
6801                 if {$j > $i} {
6802                     return $t
6803                 }
6804             }
6805         }
6806         if {![info exists arcend($a)]} {
6807             return {}
6808         }
6809         set id $arcend($a)
6810         if {[info exists idtags($id)]} {
6811             return $id
6812         }
6813     }
6814     if {[info exists cached_atags($id)]} {
6815         return $cached_atags($id)
6816     }
6817
6818     set origid $id
6819     set todo [list $id]
6820     set queued($id) 1
6821     set taglist {}
6822     set nc 1
6823     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6824         set id [lindex $todo $i]
6825         set done($id) 1
6826         set td [info exists hastaggeddescendent($id)]
6827         if {!$td} {
6828             incr nc -1
6829         }
6830         # ignore tags on starting node
6831         if {!$td && $i > 0} {
6832             if {[info exists idtags($id)]} {
6833                 set tagloc($id) $id
6834                 set td 1
6835             } elseif {[info exists cached_atags($id)]} {
6836                 set tagloc($id) $cached_atags($id)
6837                 set td 1
6838             }
6839         }
6840         foreach a $arcout($id) {
6841             if {!$td && $arctags($a) ne {}} {
6842                 validate_arctags $a
6843                 if {$arctags($a) ne {}} {
6844                     lappend tagloc($id) [lindex $arctags($a) 0]
6845                 }
6846             }
6847             if {![info exists arcend($a)]} continue
6848             set d $arcend($a)
6849             if {$td || $arctags($a) ne {}} {
6850                 set tomark [list $d]
6851                 for {set j 0} {$j < [llength $tomark]} {incr j} {
6852                     set dd [lindex $tomark $j]
6853                     if {![info exists hastaggeddescendent($dd)]} {
6854                         if {[info exists done($dd)]} {
6855                             foreach b $arcout($dd) {
6856                                 if {[info exists arcend($b)]} {
6857                                     lappend tomark $arcend($b)
6858                                 }
6859                             }
6860                             if {[info exists tagloc($dd)]} {
6861                                 unset tagloc($dd)
6862                             }
6863                         } elseif {[info exists queued($dd)]} {
6864                             incr nc -1
6865                         }
6866                         set hastaggeddescendent($dd) 1
6867                     }
6868                 }
6869             }
6870             if {![info exists queued($d)]} {
6871                 lappend todo $d
6872                 set queued($d) 1
6873                 if {![info exists hastaggeddescendent($d)]} {
6874                     incr nc
6875                 }
6876             }
6877         }
6878     }
6879     set t2 [clock clicks -milliseconds]
6880     set loopix $i
6881     set tags {}
6882     foreach id [array names tagloc] {
6883         if {![info exists hastaggeddescendent($id)]} {
6884             foreach t $tagloc($id) {
6885                 if {[lsearch -exact $tags $t] < 0} {
6886                     lappend tags $t
6887                 }
6888             }
6889         }
6890     }
6891
6892     # remove tags that are ancestors of other tags
6893     for {set i 0} {$i < [llength $tags]} {incr i} {
6894         set a [lindex $tags $i]
6895         for {set j 0} {$j < $i} {incr j} {
6896             set b [lindex $tags $j]
6897             set r [anc_or_desc $a $b]
6898             if {$r == -1} {
6899                 set tags [lreplace $tags $j $j]
6900                 incr j -1
6901                 incr i -1
6902             } elseif {$r == 1} {
6903                 set tags [lreplace $tags $i $i]
6904                 incr i -1
6905                 break
6906             }
6907         }
6908     }
6909
6910     if {[array names growing] ne {}} {
6911         # graph isn't finished, need to check if any tag could get
6912         # eclipsed by another tag coming later.  Simply ignore any
6913         # tags that could later get eclipsed.
6914         set ctags {}
6915         foreach t $tags {
6916             if {[is_certain $origid $t]} {
6917                 lappend ctags $t
6918             }
6919         }
6920         if {$tags eq $ctags} {
6921             set cached_atags($origid) $tags
6922         } else {
6923             set tags $ctags
6924         }
6925     } else {
6926         set cached_atags($origid) $tags
6927     }
6928     set t3 [clock clicks -milliseconds]
6929     if {0 && $t3 - $t1 >= 100} {
6930         puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
6931             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
6932     }
6933     return $tags
6934 }
6935
6936 # Return the list of IDs that have heads that are descendents of id,
6937 # including id itself if it has a head.
6938 proc descheads {id} {
6939     global arcnos arcstart arcids archeads idheads cached_dheads
6940     global allparents
6941
6942     if {![info exists allparents($id)]} {
6943         return {}
6944     }
6945     set aret {}
6946     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6947         # part-way along an arc; check it first
6948         set a [lindex $arcnos($id) 0]
6949         if {$archeads($a) ne {}} {
6950             validate_archeads $a
6951             set i [lsearch -exact $arcids($a) $id]
6952             foreach t $archeads($a) {
6953                 set j [lsearch -exact $arcids($a) $t]
6954                 if {$j > $i} break
6955                 lappend aret $t
6956             }
6957         }
6958         set id $arcstart($a)
6959     }
6960     set origid $id
6961     set todo [list $id]
6962     set seen($id) 1
6963     set ret {}
6964     for {set i 0} {$i < [llength $todo]} {incr i} {
6965         set id [lindex $todo $i]
6966         if {[info exists cached_dheads($id)]} {
6967             set ret [concat $ret $cached_dheads($id)]
6968         } else {
6969             if {[info exists idheads($id)]} {
6970                 lappend ret $id
6971             }
6972             foreach a $arcnos($id) {
6973                 if {$archeads($a) ne {}} {
6974                     validate_archeads $a
6975                     if {$archeads($a) ne {}} {
6976                         set ret [concat $ret $archeads($a)]
6977                     }
6978                 }
6979                 set d $arcstart($a)
6980                 if {![info exists seen($d)]} {
6981                     lappend todo $d
6982                     set seen($d) 1
6983                 }
6984             }
6985         }
6986     }
6987     set ret [lsort -unique $ret]
6988     set cached_dheads($origid) $ret
6989     return [concat $ret $aret]
6990 }
6991
6992 proc addedtag {id} {
6993     global arcnos arcout cached_dtags cached_atags
6994
6995     if {![info exists arcnos($id)]} return
6996     if {![info exists arcout($id)]} {
6997         recalcarc [lindex $arcnos($id) 0]
6998     }
6999     catch {unset cached_dtags}
7000     catch {unset cached_atags}
7001 }
7002
7003 proc addedhead {hid head} {
7004     global arcnos arcout cached_dheads
7005
7006     if {![info exists arcnos($hid)]} return
7007     if {![info exists arcout($hid)]} {
7008         recalcarc [lindex $arcnos($hid) 0]
7009     }
7010     catch {unset cached_dheads}
7011 }
7012
7013 proc removedhead {hid head} {
7014     global cached_dheads
7015
7016     catch {unset cached_dheads}
7017 }
7018
7019 proc movedhead {hid head} {
7020     global arcnos arcout cached_dheads
7021
7022     if {![info exists arcnos($hid)]} return
7023     if {![info exists arcout($hid)]} {
7024         recalcarc [lindex $arcnos($hid) 0]
7025     }
7026     catch {unset cached_dheads}
7027 }
7028
7029 proc changedrefs {} {
7030     global cached_dheads cached_dtags cached_atags
7031     global arctags archeads arcnos arcout idheads idtags
7032
7033     foreach id [concat [array names idheads] [array names idtags]] {
7034         if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
7035             set a [lindex $arcnos($id) 0]
7036             if {![info exists donearc($a)]} {
7037                 recalcarc $a
7038                 set donearc($a) 1
7039             }
7040         }
7041     }
7042     catch {unset cached_dtags}
7043     catch {unset cached_atags}
7044     catch {unset cached_dheads}
7045 }
7046
7047 proc rereadrefs {} {
7048     global idtags idheads idotherrefs mainhead
7049
7050     set refids [concat [array names idtags] \
7051                     [array names idheads] [array names idotherrefs]]
7052     foreach id $refids {
7053         if {![info exists ref($id)]} {
7054             set ref($id) [listrefs $id]
7055         }
7056     }
7057     set oldmainhead $mainhead
7058     readrefs
7059     changedrefs
7060     set refids [lsort -unique [concat $refids [array names idtags] \
7061                         [array names idheads] [array names idotherrefs]]]
7062     foreach id $refids {
7063         set v [listrefs $id]
7064         if {![info exists ref($id)] || $ref($id) != $v ||
7065             ($id eq $oldmainhead && $id ne $mainhead) ||
7066             ($id eq $mainhead && $id ne $oldmainhead)} {
7067             redrawtags $id
7068         }
7069     }
7070 }
7071
7072 proc listrefs {id} {
7073     global idtags idheads idotherrefs
7074
7075     set x {}
7076     if {[info exists idtags($id)]} {
7077         set x $idtags($id)
7078     }
7079     set y {}
7080     if {[info exists idheads($id)]} {
7081         set y $idheads($id)
7082     }
7083     set z {}
7084     if {[info exists idotherrefs($id)]} {
7085         set z $idotherrefs($id)
7086     }
7087     return [list $x $y $z]
7088 }
7089
7090 proc showtag {tag isnew} {
7091     global ctext tagcontents tagids linknum tagobjid
7092
7093     if {$isnew} {
7094         addtohistory [list showtag $tag 0]
7095     }
7096     $ctext conf -state normal
7097     clear_ctext
7098     set linknum 0
7099     if {![info exists tagcontents($tag)]} {
7100         catch {
7101             set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
7102         }
7103     }
7104     if {[info exists tagcontents($tag)]} {
7105         set text $tagcontents($tag)
7106     } else {
7107         set text "Tag: $tag\nId:  $tagids($tag)"
7108     }
7109     appendwithlinks $text {}
7110     $ctext conf -state disabled
7111     init_flist {}
7112 }
7113
7114 proc doquit {} {
7115     global stopped
7116     set stopped 100
7117     savestuff .
7118     destroy .
7119 }
7120
7121 proc doprefs {} {
7122     global maxwidth maxgraphpct diffopts
7123     global oldprefs prefstop showneartags showlocalchanges
7124     global bgcolor fgcolor ctext diffcolors selectbgcolor
7125     global uifont tabstop
7126
7127     set top .gitkprefs
7128     set prefstop $top
7129     if {[winfo exists $top]} {
7130         raise $top
7131         return
7132     }
7133     foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7134         set oldprefs($v) [set $v]
7135     }
7136     toplevel $top
7137     wm title $top "Gitk preferences"
7138     label $top.ldisp -text "Commit list display options"
7139     $top.ldisp configure -font $uifont
7140     grid $top.ldisp - -sticky w -pady 10
7141     label $top.spacer -text " "
7142     label $top.maxwidthl -text "Maximum graph width (lines)" \
7143         -font optionfont
7144     spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7145     grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7146     label $top.maxpctl -text "Maximum graph width (% of pane)" \
7147         -font optionfont
7148     spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7149     grid x $top.maxpctl $top.maxpct -sticky w
7150     frame $top.showlocal
7151     label $top.showlocal.l -text "Show local changes" -font optionfont
7152     checkbutton $top.showlocal.b -variable showlocalchanges
7153     pack $top.showlocal.b $top.showlocal.l -side left
7154     grid x $top.showlocal -sticky w
7155
7156     label $top.ddisp -text "Diff display options"
7157     $top.ddisp configure -font $uifont
7158     grid $top.ddisp - -sticky w -pady 10
7159     label $top.diffoptl -text "Options for diff program" \
7160         -font optionfont
7161     entry $top.diffopt -width 20 -textvariable diffopts
7162     grid x $top.diffoptl $top.diffopt -sticky w
7163     frame $top.ntag
7164     label $top.ntag.l -text "Display nearby tags" -font optionfont
7165     checkbutton $top.ntag.b -variable showneartags
7166     pack $top.ntag.b $top.ntag.l -side left
7167     grid x $top.ntag -sticky w
7168     label $top.tabstopl -text "tabstop" -font optionfont
7169     spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7170     grid x $top.tabstopl $top.tabstop -sticky w
7171
7172     label $top.cdisp -text "Colors: press to choose"
7173     $top.cdisp configure -font $uifont
7174     grid $top.cdisp - -sticky w -pady 10
7175     label $top.bg -padx 40 -relief sunk -background $bgcolor
7176     button $top.bgbut -text "Background" -font optionfont \
7177         -command [list choosecolor bgcolor 0 $top.bg background setbg]
7178     grid x $top.bgbut $top.bg -sticky w
7179     label $top.fg -padx 40 -relief sunk -background $fgcolor
7180     button $top.fgbut -text "Foreground" -font optionfont \
7181         -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
7182     grid x $top.fgbut $top.fg -sticky w
7183     label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
7184     button $top.diffoldbut -text "Diff: old lines" -font optionfont \
7185         -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
7186                       [list $ctext tag conf d0 -foreground]]
7187     grid x $top.diffoldbut $top.diffold -sticky w
7188     label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
7189     button $top.diffnewbut -text "Diff: new lines" -font optionfont \
7190         -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
7191                       [list $ctext tag conf d1 -foreground]]
7192     grid x $top.diffnewbut $top.diffnew -sticky w
7193     label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
7194     button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
7195         -command [list choosecolor diffcolors 2 $top.hunksep \
7196                       "diff hunk header" \
7197                       [list $ctext tag conf hunksep -foreground]]
7198     grid x $top.hunksepbut $top.hunksep -sticky w
7199     label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
7200     button $top.selbgbut -text "Select bg" -font optionfont \
7201         -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
7202     grid x $top.selbgbut $top.selbgsep -sticky w
7203
7204     frame $top.buts
7205     button $top.buts.ok -text "OK" -command prefsok -default active
7206     $top.buts.ok configure -font $uifont
7207     button $top.buts.can -text "Cancel" -command prefscan -default normal
7208     $top.buts.can configure -font $uifont
7209     grid $top.buts.ok $top.buts.can
7210     grid columnconfigure $top.buts 0 -weight 1 -uniform a
7211     grid columnconfigure $top.buts 1 -weight 1 -uniform a
7212     grid $top.buts - - -pady 10 -sticky ew
7213     bind $top <Visibility> "focus $top.buts.ok"
7214 }
7215
7216 proc choosecolor {v vi w x cmd} {
7217     global $v
7218
7219     set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
7220                -title "Gitk: choose color for $x"]
7221     if {$c eq {}} return
7222     $w conf -background $c
7223     lset $v $vi $c
7224     eval $cmd $c
7225 }
7226
7227 proc setselbg {c} {
7228     global bglist cflist
7229     foreach w $bglist {
7230         $w configure -selectbackground $c
7231     }
7232     $cflist tag configure highlight \
7233         -background [$cflist cget -selectbackground]
7234     allcanvs itemconf secsel -fill $c
7235 }
7236
7237 proc setbg {c} {
7238     global bglist
7239
7240     foreach w $bglist {
7241         $w conf -background $c
7242     }
7243 }
7244
7245 proc setfg {c} {
7246     global fglist canv
7247
7248     foreach w $fglist {
7249         $w conf -foreground $c
7250     }
7251     allcanvs itemconf text -fill $c
7252     $canv itemconf circle -outline $c
7253 }
7254
7255 proc prefscan {} {
7256     global maxwidth maxgraphpct diffopts
7257     global oldprefs prefstop showneartags showlocalchanges
7258
7259     foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7260         set $v $oldprefs($v)
7261     }
7262     catch {destroy $prefstop}
7263     unset prefstop
7264 }
7265
7266 proc prefsok {} {
7267     global maxwidth maxgraphpct
7268     global oldprefs prefstop showneartags showlocalchanges
7269     global charspc ctext tabstop
7270
7271     catch {destroy $prefstop}
7272     unset prefstop
7273     $ctext configure -tabs "[expr {$tabstop * $charspc}]"
7274     if {$showlocalchanges != $oldprefs(showlocalchanges)} {
7275         if {$showlocalchanges} {
7276             doshowlocalchanges
7277         } else {
7278             dohidelocalchanges
7279         }
7280     }
7281     if {$maxwidth != $oldprefs(maxwidth)
7282         || $maxgraphpct != $oldprefs(maxgraphpct)} {
7283         redisplay
7284     } elseif {$showneartags != $oldprefs(showneartags)} {
7285         reselectline
7286     }
7287 }
7288
7289 proc formatdate {d} {
7290     if {$d ne {}} {
7291         set d [clock format $d -format "%Y-%m-%d %H:%M:%S"]
7292     }
7293     return $d
7294 }
7295
7296 # This list of encoding names and aliases is distilled from
7297 # http://www.iana.org/assignments/character-sets.
7298 # Not all of them are supported by Tcl.
7299 set encoding_aliases {
7300     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
7301       ISO646-US US-ASCII us IBM367 cp367 csASCII }
7302     { ISO-10646-UTF-1 csISO10646UTF1 }
7303     { ISO_646.basic:1983 ref csISO646basic1983 }
7304     { INVARIANT csINVARIANT }
7305     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
7306     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
7307     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
7308     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
7309     { NATS-DANO iso-ir-9-1 csNATSDANO }
7310     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
7311     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
7312     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
7313     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
7314     { ISO-2022-KR csISO2022KR }
7315     { EUC-KR csEUCKR }
7316     { ISO-2022-JP csISO2022JP }
7317     { ISO-2022-JP-2 csISO2022JP2 }
7318     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
7319       csISO13JISC6220jp }
7320     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
7321     { IT iso-ir-15 ISO646-IT csISO15Italian }
7322     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
7323     { ES iso-ir-17 ISO646-ES csISO17Spanish }
7324     { greek7-old iso-ir-18 csISO18Greek7Old }
7325     { latin-greek iso-ir-19 csISO19LatinGreek }
7326     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
7327     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
7328     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
7329     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
7330     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
7331     { BS_viewdata iso-ir-47 csISO47BSViewdata }
7332     { INIS iso-ir-49 csISO49INIS }
7333     { INIS-8 iso-ir-50 csISO50INIS8 }
7334     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
7335     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
7336     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
7337     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
7338     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
7339     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
7340       csISO60Norwegian1 }
7341     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
7342     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
7343     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
7344     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
7345     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
7346     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
7347     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
7348     { greek7 iso-ir-88 csISO88Greek7 }
7349     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
7350     { iso-ir-90 csISO90 }
7351     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
7352     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
7353       csISO92JISC62991984b }
7354     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
7355     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
7356     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
7357       csISO95JIS62291984handadd }
7358     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
7359     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
7360     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
7361     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
7362       CP819 csISOLatin1 }
7363     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
7364     { T.61-7bit iso-ir-102 csISO102T617bit }
7365     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
7366     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
7367     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
7368     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
7369     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
7370     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
7371     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
7372     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
7373       arabic csISOLatinArabic }
7374     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
7375     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
7376     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
7377       greek greek8 csISOLatinGreek }
7378     { T.101-G2 iso-ir-128 csISO128T101G2 }
7379     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
7380       csISOLatinHebrew }
7381     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
7382     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
7383     { CSN_369103 iso-ir-139 csISO139CSN369103 }
7384     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
7385     { ISO_6937-2-add iso-ir-142 csISOTextComm }
7386     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
7387     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
7388       csISOLatinCyrillic }
7389     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
7390     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
7391     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
7392     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
7393     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
7394     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
7395     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
7396     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
7397     { ISO_10367-box iso-ir-155 csISO10367Box }
7398     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
7399     { latin-lap lap iso-ir-158 csISO158Lap }
7400     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
7401     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
7402     { us-dk csUSDK }
7403     { dk-us csDKUS }
7404     { JIS_X0201 X0201 csHalfWidthKatakana }
7405     { KSC5636 ISO646-KR csKSC5636 }
7406     { ISO-10646-UCS-2 csUnicode }
7407     { ISO-10646-UCS-4 csUCS4 }
7408     { DEC-MCS dec csDECMCS }
7409     { hp-roman8 roman8 r8 csHPRoman8 }
7410     { macintosh mac csMacintosh }
7411     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
7412       csIBM037 }
7413     { IBM038 EBCDIC-INT cp038 csIBM038 }
7414     { IBM273 CP273 csIBM273 }
7415     { IBM274 EBCDIC-BE CP274 csIBM274 }
7416     { IBM275 EBCDIC-BR cp275 csIBM275 }
7417     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
7418     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
7419     { IBM280 CP280 ebcdic-cp-it csIBM280 }
7420     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
7421     { IBM284 CP284 ebcdic-cp-es csIBM284 }
7422     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
7423     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
7424     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
7425     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
7426     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
7427     { IBM424 cp424 ebcdic-cp-he csIBM424 }
7428     { IBM437 cp437 437 csPC8CodePage437 }
7429     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
7430     { IBM775 cp775 csPC775Baltic }
7431     { IBM850 cp850 850 csPC850Multilingual }
7432     { IBM851 cp851 851 csIBM851 }
7433     { IBM852 cp852 852 csPCp852 }
7434     { IBM855 cp855 855 csIBM855 }
7435     { IBM857 cp857 857 csIBM857 }
7436     { IBM860 cp860 860 csIBM860 }
7437     { IBM861 cp861 861 cp-is csIBM861 }
7438     { IBM862 cp862 862 csPC862LatinHebrew }
7439     { IBM863 cp863 863 csIBM863 }
7440     { IBM864 cp864 csIBM864 }
7441     { IBM865 cp865 865 csIBM865 }
7442     { IBM866 cp866 866 csIBM866 }
7443     { IBM868 CP868 cp-ar csIBM868 }
7444     { IBM869 cp869 869 cp-gr csIBM869 }
7445     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
7446     { IBM871 CP871 ebcdic-cp-is csIBM871 }
7447     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
7448     { IBM891 cp891 csIBM891 }
7449     { IBM903 cp903 csIBM903 }
7450     { IBM904 cp904 904 csIBBM904 }
7451     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
7452     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
7453     { IBM1026 CP1026 csIBM1026 }
7454     { EBCDIC-AT-DE csIBMEBCDICATDE }
7455     { EBCDIC-AT-DE-A csEBCDICATDEA }
7456     { EBCDIC-CA-FR csEBCDICCAFR }
7457     { EBCDIC-DK-NO csEBCDICDKNO }
7458     { EBCDIC-DK-NO-A csEBCDICDKNOA }
7459     { EBCDIC-FI-SE csEBCDICFISE }
7460     { EBCDIC-FI-SE-A csEBCDICFISEA }
7461     { EBCDIC-FR csEBCDICFR }
7462     { EBCDIC-IT csEBCDICIT }
7463     { EBCDIC-PT csEBCDICPT }
7464     { EBCDIC-ES csEBCDICES }
7465     { EBCDIC-ES-A csEBCDICESA }
7466     { EBCDIC-ES-S csEBCDICESS }
7467     { EBCDIC-UK csEBCDICUK }
7468     { EBCDIC-US csEBCDICUS }
7469     { UNKNOWN-8BIT csUnknown8BiT }
7470     { MNEMONIC csMnemonic }
7471     { MNEM csMnem }
7472     { VISCII csVISCII }
7473     { VIQR csVIQR }
7474     { KOI8-R csKOI8R }
7475     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
7476     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
7477     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
7478     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
7479     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
7480     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
7481     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
7482     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
7483     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
7484     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
7485     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
7486     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
7487     { IBM1047 IBM-1047 }
7488     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
7489     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
7490     { UNICODE-1-1 csUnicode11 }
7491     { CESU-8 csCESU-8 }
7492     { BOCU-1 csBOCU-1 }
7493     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
7494     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
7495       l8 }
7496     { ISO-8859-15 ISO_8859-15 Latin-9 }
7497     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
7498     { GBK CP936 MS936 windows-936 }
7499     { JIS_Encoding csJISEncoding }
7500     { Shift_JIS MS_Kanji csShiftJIS }
7501     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
7502       EUC-JP }
7503     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
7504     { ISO-10646-UCS-Basic csUnicodeASCII }
7505     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
7506     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
7507     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
7508     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
7509     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
7510     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
7511     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
7512     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
7513     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
7514     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
7515     { Adobe-Standard-Encoding csAdobeStandardEncoding }
7516     { Ventura-US csVenturaUS }
7517     { Ventura-International csVenturaInternational }
7518     { PC8-Danish-Norwegian csPC8DanishNorwegian }
7519     { PC8-Turkish csPC8Turkish }
7520     { IBM-Symbols csIBMSymbols }
7521     { IBM-Thai csIBMThai }
7522     { HP-Legal csHPLegal }
7523     { HP-Pi-font csHPPiFont }
7524     { HP-Math8 csHPMath8 }
7525     { Adobe-Symbol-Encoding csHPPSMath }
7526     { HP-DeskTop csHPDesktop }
7527     { Ventura-Math csVenturaMath }
7528     { Microsoft-Publishing csMicrosoftPublishing }
7529     { Windows-31J csWindows31J }
7530     { GB2312 csGB2312 }
7531     { Big5 csBig5 }
7532 }
7533
7534 proc tcl_encoding {enc} {
7535     global encoding_aliases
7536     set names [encoding names]
7537     set lcnames [string tolower $names]
7538     set enc [string tolower $enc]
7539     set i [lsearch -exact $lcnames $enc]
7540     if {$i < 0} {
7541         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
7542         if {[regsub {^iso[-_]} $enc iso encx]} {
7543             set i [lsearch -exact $lcnames $encx]
7544         }
7545     }
7546     if {$i < 0} {
7547         foreach l $encoding_aliases {
7548             set ll [string tolower $l]
7549             if {[lsearch -exact $ll $enc] < 0} continue
7550             # look through the aliases for one that tcl knows about
7551             foreach e $ll {
7552                 set i [lsearch -exact $lcnames $e]
7553                 if {$i < 0} {
7554                     if {[regsub {^iso[-_]} $e iso ex]} {
7555                         set i [lsearch -exact $lcnames $ex]
7556                     }
7557                 }
7558                 if {$i >= 0} break
7559             }
7560             break
7561         }
7562     }
7563     if {$i >= 0} {
7564         return [lindex $names $i]
7565     }
7566     return {}
7567 }
7568
7569 # defaults...
7570 set datemode 0
7571 set diffopts "-U 5 -p"
7572 set wrcomcmd "git diff-tree --stdin -p --pretty"
7573
7574 set gitencoding {}
7575 catch {
7576     set gitencoding [exec git config --get i18n.commitencoding]
7577 }
7578 if {$gitencoding == ""} {
7579     set gitencoding "utf-8"
7580 }
7581 set tclencoding [tcl_encoding $gitencoding]
7582 if {$tclencoding == {}} {
7583     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
7584 }
7585
7586 set mainfont {Helvetica 9}
7587 set textfont {Courier 9}
7588 set uifont {Helvetica 9 bold}
7589 set tabstop 8
7590 set findmergefiles 0
7591 set maxgraphpct 50
7592 set maxwidth 16
7593 set revlistorder 0
7594 set fastdate 0
7595 set uparrowlen 7
7596 set downarrowlen 7
7597 set mingaplen 30
7598 set cmitmode "patch"
7599 set wrapcomment "none"
7600 set showneartags 1
7601 set maxrefs 20
7602 set maxlinelen 200
7603 set showlocalchanges 1
7604
7605 set colors {green red blue magenta darkgrey brown orange}
7606 set bgcolor white
7607 set fgcolor black
7608 set diffcolors {red "#00a000" blue}
7609 set selectbgcolor gray85
7610
7611 catch {source ~/.gitk}
7612
7613 font create optionfont -family sans-serif -size -12
7614
7615 # check that we can find a .git directory somewhere...
7616 set gitdir [gitdir]
7617 if {![file isdirectory $gitdir]} {
7618     show_error {} . "Cannot find the git directory \"$gitdir\"."
7619     exit 1
7620 }
7621
7622 set revtreeargs {}
7623 set cmdline_files {}
7624 set i 0
7625 foreach arg $argv {
7626     switch -- $arg {
7627         "" { }
7628         "-d" { set datemode 1 }
7629         "--" {
7630             set cmdline_files [lrange $argv [expr {$i + 1}] end]
7631             break
7632         }
7633         default {
7634             lappend revtreeargs $arg
7635         }
7636     }
7637     incr i
7638 }
7639
7640 if {$i >= [llength $argv] && $revtreeargs ne {}} {
7641     # no -- on command line, but some arguments (other than -d)
7642     if {[catch {
7643         set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
7644         set cmdline_files [split $f "\n"]
7645         set n [llength $cmdline_files]
7646         set revtreeargs [lrange $revtreeargs 0 end-$n]
7647         # Unfortunately git rev-parse doesn't produce an error when
7648         # something is both a revision and a filename.  To be consistent
7649         # with git log and git rev-list, check revtreeargs for filenames.
7650         foreach arg $revtreeargs {
7651             if {[file exists $arg]} {
7652                 show_error {} . "Ambiguous argument '$arg': both revision\
7653                                  and filename"
7654                 exit 1
7655             }
7656         }
7657     } err]} {
7658         # unfortunately we get both stdout and stderr in $err,
7659         # so look for "fatal:".
7660         set i [string first "fatal:" $err]
7661         if {$i > 0} {
7662             set err [string range $err [expr {$i + 6}] end]
7663         }
7664         show_error {} . "Bad arguments to gitk:\n$err"
7665         exit 1
7666     }
7667 }
7668
7669 set nullid "0000000000000000000000000000000000000000"
7670 set nullid2 "0000000000000000000000000000000000000001"
7671
7672
7673 set runq {}
7674 set history {}
7675 set historyindex 0
7676 set fh_serial 0
7677 set nhl_names {}
7678 set highlight_paths {}
7679 set searchdirn -forwards
7680 set boldrows {}
7681 set boldnamerows {}
7682 set diffelide {0 0}
7683 set markingmatches 0
7684
7685 set optim_delay 16
7686
7687 set nextviewnum 1
7688 set curview 0
7689 set selectedview 0
7690 set selectedhlview None
7691 set viewfiles(0) {}
7692 set viewperm(0) 0
7693 set viewargs(0) {}
7694
7695 set cmdlineok 0
7696 set stopped 0
7697 set stuffsaved 0
7698 set patchnum 0
7699 set lookingforhead 0
7700 set localirow -1
7701 set localfrow -1
7702 set lserial 0
7703 setcoords
7704 makewindow
7705 # wait for the window to become visible
7706 tkwait visibility .
7707 wm title . "[file tail $argv0]: [file tail [pwd]]"
7708 readrefs
7709
7710 if {$cmdline_files ne {} || $revtreeargs ne {}} {
7711     # create a view for the files/dirs specified on the command line
7712     set curview 1
7713     set selectedview 1
7714     set nextviewnum 2
7715     set viewname(1) "Command line"
7716     set viewfiles(1) $cmdline_files
7717     set viewargs(1) $revtreeargs
7718     set viewperm(1) 0
7719     addviewmenu 1
7720     .bar.view entryconf Edit* -state normal
7721     .bar.view entryconf Delete* -state normal
7722 }
7723
7724 if {[info exists permviews]} {
7725     foreach v $permviews {
7726         set n $nextviewnum
7727         incr nextviewnum
7728         set viewname($n) [lindex $v 0]
7729         set viewfiles($n) [lindex $v 1]
7730         set viewargs($n) [lindex $v 2]
7731         set viewperm($n) 1
7732         addviewmenu $n
7733     }
7734 }
7735 getcommits