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