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