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                 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
5226                 if {[string index $fname 0] eq "\""} {
5227                     set fname [lindex $fname 0]
5228                 }
5229                 set i [lsearch -exact $treediffs($ids) $fname]
5230                 if {$i >= 0} {
5231                     setinlist difffilestart $i $curdiffstart
5232                 }
5233             } elseif {![string compare -length 10 $line "rename to "] ||
5234                       ![string compare -length 8 $line "copy to "]} {
5235                 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
5236                 if {[string index $fname 0] eq "\""} {
5237                     set fname [lindex $fname 0]
5238                 }
5239                 makediffhdr $fname $ids
5240             } elseif {[string compare -length 3 $line "---"] == 0} {
5241                 # do nothing
5242                 continue
5243             } elseif {[string compare -length 3 $line "+++"] == 0} {
5244                 set diffinhdr 0
5245                 continue
5246             }
5247             $ctext insert end "$line\n" filesep
5248
5249         } else {
5250             set x [string range $line 0 0]
5251             if {$x == "-" || $x == "+"} {
5252                 set tag [expr {$x == "+"}]
5253                 $ctext insert end "$line\n" d$tag
5254             } elseif {$x == " "} {
5255                 $ctext insert end "$line\n"
5256             } else {
5257                 # "\ No newline at end of file",
5258                 # or something else we don't recognize
5259                 $ctext insert end "$line\n" hunksep
5260             }
5261         }
5262     }
5263     $ctext conf -state disabled
5264     if {[eof $bdf]} {
5265         close $bdf
5266         return 0
5267     }
5268     return [expr {$nr >= 1000? 2: 1}]
5269 }
5270
5271 proc changediffdisp {} {
5272     global ctext diffelide
5273
5274     $ctext tag conf d0 -elide [lindex $diffelide 0]
5275     $ctext tag conf d1 -elide [lindex $diffelide 1]
5276 }
5277
5278 proc prevfile {} {
5279     global difffilestart ctext
5280     set prev [lindex $difffilestart 0]
5281     set here [$ctext index @0,0]
5282     foreach loc $difffilestart {
5283         if {[$ctext compare $loc >= $here]} {
5284             $ctext yview $prev
5285             return
5286         }
5287         set prev $loc
5288     }
5289     $ctext yview $prev
5290 }
5291
5292 proc nextfile {} {
5293     global difffilestart ctext
5294     set here [$ctext index @0,0]
5295     foreach loc $difffilestart {
5296         if {[$ctext compare $loc > $here]} {
5297             $ctext yview $loc
5298             return
5299         }
5300     }
5301 }
5302
5303 proc clear_ctext {{first 1.0}} {
5304     global ctext smarktop smarkbot
5305
5306     set l [lindex [split $first .] 0]
5307     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5308         set smarktop $l
5309     }
5310     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5311         set smarkbot $l
5312     }
5313     $ctext delete $first end
5314 }
5315
5316 proc incrsearch {name ix op} {
5317     global ctext searchstring searchdirn
5318
5319     $ctext tag remove found 1.0 end
5320     if {[catch {$ctext index anchor}]} {
5321         # no anchor set, use start of selection, or of visible area
5322         set sel [$ctext tag ranges sel]
5323         if {$sel ne {}} {
5324             $ctext mark set anchor [lindex $sel 0]
5325         } elseif {$searchdirn eq "-forwards"} {
5326             $ctext mark set anchor @0,0
5327         } else {
5328             $ctext mark set anchor @0,[winfo height $ctext]
5329         }
5330     }
5331     if {$searchstring ne {}} {
5332         set here [$ctext search $searchdirn -- $searchstring anchor]
5333         if {$here ne {}} {
5334             $ctext see $here
5335         }
5336         searchmarkvisible 1
5337     }
5338 }
5339
5340 proc dosearch {} {
5341     global sstring ctext searchstring searchdirn
5342
5343     focus $sstring
5344     $sstring icursor end
5345     set searchdirn -forwards
5346     if {$searchstring ne {}} {
5347         set sel [$ctext tag ranges sel]
5348         if {$sel ne {}} {
5349             set start "[lindex $sel 0] + 1c"
5350         } elseif {[catch {set start [$ctext index anchor]}]} {
5351             set start "@0,0"
5352         }
5353         set match [$ctext search -count mlen -- $searchstring $start]
5354         $ctext tag remove sel 1.0 end
5355         if {$match eq {}} {
5356             bell
5357             return
5358         }
5359         $ctext see $match
5360         set mend "$match + $mlen c"
5361         $ctext tag add sel $match $mend
5362         $ctext mark unset anchor
5363     }
5364 }
5365
5366 proc dosearchback {} {
5367     global sstring ctext searchstring searchdirn
5368
5369     focus $sstring
5370     $sstring icursor end
5371     set searchdirn -backwards
5372     if {$searchstring ne {}} {
5373         set sel [$ctext tag ranges sel]
5374         if {$sel ne {}} {
5375             set start [lindex $sel 0]
5376         } elseif {[catch {set start [$ctext index anchor]}]} {
5377             set start @0,[winfo height $ctext]
5378         }
5379         set match [$ctext search -backwards -count ml -- $searchstring $start]
5380         $ctext tag remove sel 1.0 end
5381         if {$match eq {}} {
5382             bell
5383             return
5384         }
5385         $ctext see $match
5386         set mend "$match + $ml c"
5387         $ctext tag add sel $match $mend
5388         $ctext mark unset anchor
5389     }
5390 }
5391
5392 proc searchmark {first last} {
5393     global ctext searchstring
5394
5395     set mend $first.0
5396     while {1} {
5397         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5398         if {$match eq {}} break
5399         set mend "$match + $mlen c"
5400         $ctext tag add found $match $mend
5401     }
5402 }
5403
5404 proc searchmarkvisible {doall} {
5405     global ctext smarktop smarkbot
5406
5407     set topline [lindex [split [$ctext index @0,0] .] 0]
5408     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5409     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5410         # no overlap with previous
5411         searchmark $topline $botline
5412         set smarktop $topline
5413         set smarkbot $botline
5414     } else {
5415         if {$topline < $smarktop} {
5416             searchmark $topline [expr {$smarktop-1}]
5417             set smarktop $topline
5418         }
5419         if {$botline > $smarkbot} {
5420             searchmark [expr {$smarkbot+1}] $botline
5421             set smarkbot $botline
5422         }
5423     }
5424 }
5425
5426 proc scrolltext {f0 f1} {
5427     global searchstring
5428
5429     .bleft.sb set $f0 $f1
5430     if {$searchstring ne {}} {
5431         searchmarkvisible 0
5432     }
5433 }
5434
5435 proc setcoords {} {
5436     global linespc charspc canvx0 canvy0 mainfont
5437     global xspc1 xspc2 lthickness
5438
5439     set linespc [font metrics $mainfont -linespace]
5440     set charspc [font measure $mainfont "m"]
5441     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5442     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5443     set lthickness [expr {int($linespc / 9) + 1}]
5444     set xspc1(0) $linespc
5445     set xspc2 $linespc
5446 }
5447
5448 proc redisplay {} {
5449     global canv
5450     global selectedline
5451
5452     set ymax [lindex [$canv cget -scrollregion] 3]
5453     if {$ymax eq {} || $ymax == 0} return
5454     set span [$canv yview]
5455     clear_display
5456     setcanvscroll
5457     allcanvs yview moveto [lindex $span 0]
5458     drawvisible
5459     if {[info exists selectedline]} {
5460         selectline $selectedline 0
5461         allcanvs yview moveto [lindex $span 0]
5462     }
5463 }
5464
5465 proc incrfont {inc} {
5466     global mainfont textfont ctext canv phase cflist showrefstop
5467     global charspc tabstop
5468     global stopped entries
5469     unmarkmatches
5470     set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
5471     set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
5472     setcoords
5473     $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]"
5474     $cflist conf -font $textfont
5475     $ctext tag conf filesep -font [concat $textfont bold]
5476     foreach e $entries {
5477         $e conf -font $mainfont
5478     }
5479     if {$phase eq "getcommits"} {
5480         $canv itemconf textitems -font $mainfont
5481     }
5482     if {[info exists showrefstop] && [winfo exists $showrefstop]} {
5483         $showrefstop.list conf -font $mainfont
5484     }
5485     redisplay
5486 }
5487
5488 proc clearsha1 {} {
5489     global sha1entry sha1string
5490     if {[string length $sha1string] == 40} {
5491         $sha1entry delete 0 end
5492     }
5493 }
5494
5495 proc sha1change {n1 n2 op} {
5496     global sha1string currentid sha1but
5497     if {$sha1string == {}
5498         || ([info exists currentid] && $sha1string == $currentid)} {
5499         set state disabled
5500     } else {
5501         set state normal
5502     }
5503     if {[$sha1but cget -state] == $state} return
5504     if {$state == "normal"} {
5505         $sha1but conf -state normal -relief raised -text "Goto: "
5506     } else {
5507         $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
5508     }
5509 }
5510
5511 proc gotocommit {} {
5512     global sha1string currentid commitrow tagids headids
5513     global displayorder numcommits curview
5514
5515     if {$sha1string == {}
5516         || ([info exists currentid] && $sha1string == $currentid)} return
5517     if {[info exists tagids($sha1string)]} {
5518         set id $tagids($sha1string)
5519     } elseif {[info exists headids($sha1string)]} {
5520         set id $headids($sha1string)
5521     } else {
5522         set id [string tolower $sha1string]
5523         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5524             set matches {}
5525             foreach i $displayorder {
5526                 if {[string match $id* $i]} {
5527                     lappend matches $i
5528                 }
5529             }
5530             if {$matches ne {}} {
5531                 if {[llength $matches] > 1} {
5532                     error_popup "Short SHA1 id $id is ambiguous"
5533                     return
5534                 }
5535                 set id [lindex $matches 0]
5536             }
5537         }
5538     }
5539     if {[info exists commitrow($curview,$id)]} {
5540         selectline $commitrow($curview,$id) 1
5541         return
5542     }
5543     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5544         set type "SHA1 id"
5545     } else {
5546         set type "Tag/Head"
5547     }
5548     error_popup "$type $sha1string is not known"
5549 }
5550
5551 proc lineenter {x y id} {
5552     global hoverx hovery hoverid hovertimer
5553     global commitinfo canv
5554
5555     if {![info exists commitinfo($id)] && ![getcommit $id]} return
5556     set hoverx $x
5557     set hovery $y
5558     set hoverid $id
5559     if {[info exists hovertimer]} {
5560         after cancel $hovertimer
5561     }
5562     set hovertimer [after 500 linehover]
5563     $canv delete hover
5564 }
5565
5566 proc linemotion {x y id} {
5567     global hoverx hovery hoverid hovertimer
5568
5569     if {[info exists hoverid] && $id == $hoverid} {
5570         set hoverx $x
5571         set hovery $y
5572         if {[info exists hovertimer]} {
5573             after cancel $hovertimer
5574         }
5575         set hovertimer [after 500 linehover]
5576     }
5577 }
5578
5579 proc lineleave {id} {
5580     global hoverid hovertimer canv
5581
5582     if {[info exists hoverid] && $id == $hoverid} {
5583         $canv delete hover
5584         if {[info exists hovertimer]} {
5585             after cancel $hovertimer
5586             unset hovertimer
5587         }
5588         unset hoverid
5589     }
5590 }
5591
5592 proc linehover {} {
5593     global hoverx hovery hoverid hovertimer
5594     global canv linespc lthickness
5595     global commitinfo mainfont
5596
5597     set text [lindex $commitinfo($hoverid) 0]
5598     set ymax [lindex [$canv cget -scrollregion] 3]
5599     if {$ymax == {}} return
5600     set yfrac [lindex [$canv yview] 0]
5601     set x [expr {$hoverx + 2 * $linespc}]
5602     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5603     set x0 [expr {$x - 2 * $lthickness}]
5604     set y0 [expr {$y - 2 * $lthickness}]
5605     set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
5606     set y1 [expr {$y + $linespc + 2 * $lthickness}]
5607     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5608                -fill \#ffff80 -outline black -width 1 -tags hover]
5609     $canv raise $t
5610     set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5611                -font $mainfont]
5612     $canv raise $t
5613 }
5614
5615 proc clickisonarrow {id y} {
5616     global lthickness
5617
5618     set ranges [rowranges $id]
5619     set thresh [expr {2 * $lthickness + 6}]
5620     set n [expr {[llength $ranges] - 1}]
5621     for {set i 1} {$i < $n} {incr i} {
5622         set row [lindex $ranges $i]
5623         if {abs([yc $row] - $y) < $thresh} {
5624             return $i
5625         }
5626     }
5627     return {}
5628 }
5629
5630 proc arrowjump {id n y} {
5631     global canv
5632
5633     # 1 <-> 2, 3 <-> 4, etc...
5634     set n [expr {(($n - 1) ^ 1) + 1}]
5635     set row [lindex [rowranges $id] $n]
5636     set yt [yc $row]
5637     set ymax [lindex [$canv cget -scrollregion] 3]
5638     if {$ymax eq {} || $ymax <= 0} return
5639     set view [$canv yview]
5640     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5641     set yfrac [expr {$yt / $ymax - $yspan / 2}]
5642     if {$yfrac < 0} {
5643         set yfrac 0
5644     }
5645     allcanvs yview moveto $yfrac
5646 }
5647
5648 proc lineclick {x y id isnew} {
5649     global ctext commitinfo children canv thickerline curview
5650
5651     if {![info exists commitinfo($id)] && ![getcommit $id]} return
5652     unmarkmatches
5653     unselectline
5654     normalline
5655     $canv delete hover
5656     # draw this line thicker than normal
5657     set thickerline $id
5658     drawlines $id
5659     if {$isnew} {
5660         set ymax [lindex [$canv cget -scrollregion] 3]
5661         if {$ymax eq {}} return
5662         set yfrac [lindex [$canv yview] 0]
5663         set y [expr {$y + $yfrac * $ymax}]
5664     }
5665     set dirn [clickisonarrow $id $y]
5666     if {$dirn ne {}} {
5667         arrowjump $id $dirn $y
5668         return
5669     }
5670
5671     if {$isnew} {
5672         addtohistory [list lineclick $x $y $id 0]
5673     }
5674     # fill the details pane with info about this line
5675     $ctext conf -state normal
5676     clear_ctext
5677     $ctext tag conf link -foreground blue -underline 1
5678     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5679     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5680     $ctext insert end "Parent:\t"
5681     $ctext insert end $id [list link link0]
5682     $ctext tag bind link0 <1> [list selbyid $id]
5683     set info $commitinfo($id)
5684     $ctext insert end "\n\t[lindex $info 0]\n"
5685     $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
5686     set date [formatdate [lindex $info 2]]
5687     $ctext insert end "\tDate:\t$date\n"
5688     set kids $children($curview,$id)
5689     if {$kids ne {}} {
5690         $ctext insert end "\nChildren:"
5691         set i 0
5692         foreach child $kids {
5693             incr i
5694             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5695             set info $commitinfo($child)
5696             $ctext insert end "\n\t"
5697             $ctext insert end $child [list link link$i]
5698             $ctext tag bind link$i <1> [list selbyid $child]
5699             $ctext insert end "\n\t[lindex $info 0]"
5700             $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
5701             set date [formatdate [lindex $info 2]]
5702             $ctext insert end "\n\tDate:\t$date\n"
5703         }
5704     }
5705     $ctext conf -state disabled
5706     init_flist {}
5707 }
5708
5709 proc normalline {} {
5710     global thickerline
5711     if {[info exists thickerline]} {
5712         set id $thickerline
5713         unset thickerline
5714         drawlines $id
5715     }
5716 }
5717
5718 proc selbyid {id} {
5719     global commitrow curview
5720     if {[info exists commitrow($curview,$id)]} {
5721         selectline $commitrow($curview,$id) 1
5722     }
5723 }
5724
5725 proc mstime {} {
5726     global startmstime
5727     if {![info exists startmstime]} {
5728         set startmstime [clock clicks -milliseconds]
5729     }
5730     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5731 }
5732
5733 proc rowmenu {x y id} {
5734     global rowctxmenu commitrow selectedline rowmenuid curview
5735     global nullid nullid2 fakerowmenu mainhead
5736
5737     set rowmenuid $id
5738     if {![info exists selectedline]
5739         || $commitrow($curview,$id) eq $selectedline} {
5740         set state disabled
5741     } else {
5742         set state normal
5743     }
5744     if {$id ne $nullid && $id ne $nullid2} {
5745         set menu $rowctxmenu
5746         $menu entryconfigure 7 -label "Reset $mainhead branch to here"
5747     } else {
5748         set menu $fakerowmenu
5749     }
5750     $menu entryconfigure "Diff this*" -state $state
5751     $menu entryconfigure "Diff selected*" -state $state
5752     $menu entryconfigure "Make patch" -state $state
5753     tk_popup $menu $x $y
5754 }
5755
5756 proc diffvssel {dirn} {
5757     global rowmenuid selectedline displayorder
5758
5759     if {![info exists selectedline]} return
5760     if {$dirn} {
5761         set oldid [lindex $displayorder $selectedline]
5762         set newid $rowmenuid
5763     } else {
5764         set oldid $rowmenuid
5765         set newid [lindex $displayorder $selectedline]
5766     }
5767     addtohistory [list doseldiff $oldid $newid]
5768     doseldiff $oldid $newid
5769 }
5770
5771 proc doseldiff {oldid newid} {
5772     global ctext
5773     global commitinfo
5774
5775     $ctext conf -state normal
5776     clear_ctext
5777     init_flist "Top"
5778     $ctext insert end "From "
5779     $ctext tag conf link -foreground blue -underline 1
5780     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5781     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5782     $ctext tag bind link0 <1> [list selbyid $oldid]
5783     $ctext insert end $oldid [list link link0]
5784     $ctext insert end "\n     "
5785     $ctext insert end [lindex $commitinfo($oldid) 0]
5786     $ctext insert end "\n\nTo   "
5787     $ctext tag bind link1 <1> [list selbyid $newid]
5788     $ctext insert end $newid [list link link1]
5789     $ctext insert end "\n     "
5790     $ctext insert end [lindex $commitinfo($newid) 0]
5791     $ctext insert end "\n"
5792     $ctext conf -state disabled
5793     $ctext tag remove found 1.0 end
5794     startdiff [list $oldid $newid]
5795 }
5796
5797 proc mkpatch {} {
5798     global rowmenuid currentid commitinfo patchtop patchnum
5799
5800     if {![info exists currentid]} return
5801     set oldid $currentid
5802     set oldhead [lindex $commitinfo($oldid) 0]
5803     set newid $rowmenuid
5804     set newhead [lindex $commitinfo($newid) 0]
5805     set top .patch
5806     set patchtop $top
5807     catch {destroy $top}
5808     toplevel $top
5809     label $top.title -text "Generate patch"
5810     grid $top.title - -pady 10
5811     label $top.from -text "From:"
5812     entry $top.fromsha1 -width 40 -relief flat
5813     $top.fromsha1 insert 0 $oldid
5814     $top.fromsha1 conf -state readonly
5815     grid $top.from $top.fromsha1 -sticky w
5816     entry $top.fromhead -width 60 -relief flat
5817     $top.fromhead insert 0 $oldhead
5818     $top.fromhead conf -state readonly
5819     grid x $top.fromhead -sticky w
5820     label $top.to -text "To:"
5821     entry $top.tosha1 -width 40 -relief flat
5822     $top.tosha1 insert 0 $newid
5823     $top.tosha1 conf -state readonly
5824     grid $top.to $top.tosha1 -sticky w
5825     entry $top.tohead -width 60 -relief flat
5826     $top.tohead insert 0 $newhead
5827     $top.tohead conf -state readonly
5828     grid x $top.tohead -sticky w
5829     button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5830     grid $top.rev x -pady 10
5831     label $top.flab -text "Output file:"
5832     entry $top.fname -width 60
5833     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5834     incr patchnum
5835     grid $top.flab $top.fname -sticky w
5836     frame $top.buts
5837     button $top.buts.gen -text "Generate" -command mkpatchgo
5838     button $top.buts.can -text "Cancel" -command mkpatchcan
5839     grid $top.buts.gen $top.buts.can
5840     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5841     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5842     grid $top.buts - -pady 10 -sticky ew
5843     focus $top.fname
5844 }
5845
5846 proc mkpatchrev {} {
5847     global patchtop
5848
5849     set oldid [$patchtop.fromsha1 get]
5850     set oldhead [$patchtop.fromhead get]
5851     set newid [$patchtop.tosha1 get]
5852     set newhead [$patchtop.tohead get]
5853     foreach e [list fromsha1 fromhead tosha1 tohead] \
5854             v [list $newid $newhead $oldid $oldhead] {
5855         $patchtop.$e conf -state normal
5856         $patchtop.$e delete 0 end
5857         $patchtop.$e insert 0 $v
5858         $patchtop.$e conf -state readonly
5859     }
5860 }
5861
5862 proc mkpatchgo {} {
5863     global patchtop nullid nullid2
5864
5865     set oldid [$patchtop.fromsha1 get]
5866     set newid [$patchtop.tosha1 get]
5867     set fname [$patchtop.fname get]
5868     set cmd [diffcmd [list $oldid $newid] -p]
5869     lappend cmd >$fname &
5870     if {[catch {eval exec $cmd} err]} {
5871         error_popup "Error creating patch: $err"
5872     }
5873     catch {destroy $patchtop}
5874     unset patchtop
5875 }
5876
5877 proc mkpatchcan {} {
5878     global patchtop
5879
5880     catch {destroy $patchtop}
5881     unset patchtop
5882 }
5883
5884 proc mktag {} {
5885     global rowmenuid mktagtop commitinfo
5886
5887     set top .maketag
5888     set mktagtop $top
5889     catch {destroy $top}
5890     toplevel $top
5891     label $top.title -text "Create tag"
5892     grid $top.title - -pady 10
5893     label $top.id -text "ID:"
5894     entry $top.sha1 -width 40 -relief flat
5895     $top.sha1 insert 0 $rowmenuid
5896     $top.sha1 conf -state readonly
5897     grid $top.id $top.sha1 -sticky w
5898     entry $top.head -width 60 -relief flat
5899     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5900     $top.head conf -state readonly
5901     grid x $top.head -sticky w
5902     label $top.tlab -text "Tag name:"
5903     entry $top.tag -width 60
5904     grid $top.tlab $top.tag -sticky w
5905     frame $top.buts
5906     button $top.buts.gen -text "Create" -command mktaggo
5907     button $top.buts.can -text "Cancel" -command mktagcan
5908     grid $top.buts.gen $top.buts.can
5909     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5910     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5911     grid $top.buts - -pady 10 -sticky ew
5912     focus $top.tag
5913 }
5914
5915 proc domktag {} {
5916     global mktagtop env tagids idtags
5917
5918     set id [$mktagtop.sha1 get]
5919     set tag [$mktagtop.tag get]
5920     if {$tag == {}} {
5921         error_popup "No tag name specified"
5922         return
5923     }
5924     if {[info exists tagids($tag)]} {
5925         error_popup "Tag \"$tag\" already exists"
5926         return
5927     }
5928     if {[catch {
5929         set dir [gitdir]
5930         set fname [file join $dir "refs/tags" $tag]
5931         set f [open $fname w]
5932         puts $f $id
5933         close $f
5934     } err]} {
5935         error_popup "Error creating tag: $err"
5936         return
5937     }
5938
5939     set tagids($tag) $id
5940     lappend idtags($id) $tag
5941     redrawtags $id
5942     addedtag $id
5943     dispneartags 0
5944     run refill_reflist
5945 }
5946
5947 proc redrawtags {id} {
5948     global canv linehtag commitrow idpos selectedline curview
5949     global mainfont canvxmax iddrawn
5950
5951     if {![info exists commitrow($curview,$id)]} return
5952     if {![info exists iddrawn($id)]} return
5953     drawcommits $commitrow($curview,$id)
5954     $canv delete tag.$id
5955     set xt [eval drawtags $id $idpos($id)]
5956     $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5957     set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5958     set xr [expr {$xt + [font measure $mainfont $text]}]
5959     if {$xr > $canvxmax} {
5960         set canvxmax $xr
5961         setcanvscroll
5962     }
5963     if {[info exists selectedline]
5964         && $selectedline == $commitrow($curview,$id)} {
5965         selectline $selectedline 0
5966     }
5967 }
5968
5969 proc mktagcan {} {
5970     global mktagtop
5971
5972     catch {destroy $mktagtop}
5973     unset mktagtop
5974 }
5975
5976 proc mktaggo {} {
5977     domktag
5978     mktagcan
5979 }
5980
5981 proc writecommit {} {
5982     global rowmenuid wrcomtop commitinfo wrcomcmd
5983
5984     set top .writecommit
5985     set wrcomtop $top
5986     catch {destroy $top}
5987     toplevel $top
5988     label $top.title -text "Write commit to file"
5989     grid $top.title - -pady 10
5990     label $top.id -text "ID:"
5991     entry $top.sha1 -width 40 -relief flat
5992     $top.sha1 insert 0 $rowmenuid
5993     $top.sha1 conf -state readonly
5994     grid $top.id $top.sha1 -sticky w
5995     entry $top.head -width 60 -relief flat
5996     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5997     $top.head conf -state readonly
5998     grid x $top.head -sticky w
5999     label $top.clab -text "Command:"
6000     entry $top.cmd -width 60 -textvariable wrcomcmd
6001     grid $top.clab $top.cmd -sticky w -pady 10
6002     label $top.flab -text "Output file:"
6003     entry $top.fname -width 60
6004     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
6005     grid $top.flab $top.fname -sticky w
6006     frame $top.buts
6007     button $top.buts.gen -text "Write" -command wrcomgo
6008     button $top.buts.can -text "Cancel" -command wrcomcan
6009     grid $top.buts.gen $top.buts.can
6010     grid columnconfigure $top.buts 0 -weight 1 -uniform a
6011     grid columnconfigure $top.buts 1 -weight 1 -uniform a
6012     grid $top.buts - -pady 10 -sticky ew
6013     focus $top.fname
6014 }
6015
6016 proc wrcomgo {} {
6017     global wrcomtop
6018
6019     set id [$wrcomtop.sha1 get]
6020     set cmd "echo $id | [$wrcomtop.cmd get]"
6021     set fname [$wrcomtop.fname get]
6022     if {[catch {exec sh -c $cmd >$fname &} err]} {
6023         error_popup "Error writing commit: $err"
6024     }
6025     catch {destroy $wrcomtop}
6026     unset wrcomtop
6027 }
6028
6029 proc wrcomcan {} {
6030     global wrcomtop
6031
6032     catch {destroy $wrcomtop}
6033     unset wrcomtop
6034 }
6035
6036 proc mkbranch {} {
6037     global rowmenuid mkbrtop
6038
6039     set top .makebranch
6040     catch {destroy $top}
6041     toplevel $top
6042     label $top.title -text "Create new branch"
6043     grid $top.title - -pady 10
6044     label $top.id -text "ID:"
6045     entry $top.sha1 -width 40 -relief flat
6046     $top.sha1 insert 0 $rowmenuid
6047     $top.sha1 conf -state readonly
6048     grid $top.id $top.sha1 -sticky w
6049     label $top.nlab -text "Name:"
6050     entry $top.name -width 40
6051     grid $top.nlab $top.name -sticky w
6052     frame $top.buts
6053     button $top.buts.go -text "Create" -command [list mkbrgo $top]
6054     button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
6055     grid $top.buts.go $top.buts.can
6056     grid columnconfigure $top.buts 0 -weight 1 -uniform a
6057     grid columnconfigure $top.buts 1 -weight 1 -uniform a
6058     grid $top.buts - -pady 10 -sticky ew
6059     focus $top.name
6060 }
6061
6062 proc mkbrgo {top} {
6063     global headids idheads
6064
6065     set name [$top.name get]
6066     set id [$top.sha1 get]
6067     if {$name eq {}} {
6068         error_popup "Please specify a name for the new branch"
6069         return
6070     }
6071     catch {destroy $top}
6072     nowbusy newbranch
6073     update
6074     if {[catch {
6075         exec git branch $name $id
6076     } err]} {
6077         notbusy newbranch
6078         error_popup $err
6079     } else {
6080         set headids($name) $id
6081         lappend idheads($id) $name
6082         addedhead $id $name
6083         notbusy newbranch
6084         redrawtags $id
6085         dispneartags 0
6086         run refill_reflist
6087     }
6088 }
6089
6090 proc cherrypick {} {
6091     global rowmenuid curview commitrow
6092     global mainhead
6093
6094     set oldhead [exec git rev-parse HEAD]
6095     set dheads [descheads $rowmenuid]
6096     if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
6097         set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
6098                         included in branch $mainhead -- really re-apply it?"]
6099         if {!$ok} return
6100     }
6101     nowbusy cherrypick
6102     update
6103     # Unfortunately git-cherry-pick writes stuff to stderr even when
6104     # no error occurs, and exec takes that as an indication of error...
6105     if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
6106         notbusy cherrypick
6107         error_popup $err
6108         return
6109     }
6110     set newhead [exec git rev-parse HEAD]
6111     if {$newhead eq $oldhead} {
6112         notbusy cherrypick
6113         error_popup "No changes committed"
6114         return
6115     }
6116     addnewchild $newhead $oldhead
6117     if {[info exists commitrow($curview,$oldhead)]} {
6118         insertrow $commitrow($curview,$oldhead) $newhead
6119         if {$mainhead ne {}} {
6120             movehead $newhead $mainhead
6121             movedhead $newhead $mainhead
6122         }
6123         redrawtags $oldhead
6124         redrawtags $newhead
6125     }
6126     notbusy cherrypick
6127 }
6128
6129 proc resethead {} {
6130     global mainheadid mainhead rowmenuid confirm_ok resettype
6131     global showlocalchanges
6132
6133     set confirm_ok 0
6134     set w ".confirmreset"
6135     toplevel $w
6136     wm transient $w .
6137     wm title $w "Confirm reset"
6138     message $w.m -text \
6139         "Reset branch $mainhead to [string range $rowmenuid 0 7]?" \
6140         -justify center -aspect 1000
6141     pack $w.m -side top -fill x -padx 20 -pady 20
6142     frame $w.f -relief sunken -border 2
6143     message $w.f.rt -text "Reset type:" -aspect 1000
6144     grid $w.f.rt -sticky w
6145     set resettype mixed
6146     radiobutton $w.f.soft -value soft -variable resettype -justify left \
6147         -text "Soft: Leave working tree and index untouched"
6148     grid $w.f.soft -sticky w
6149     radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
6150         -text "Mixed: Leave working tree untouched, reset index"
6151     grid $w.f.mixed -sticky w
6152     radiobutton $w.f.hard -value hard -variable resettype -justify left \
6153         -text "Hard: Reset working tree and index\n(discard ALL local changes)"
6154     grid $w.f.hard -sticky w
6155     pack $w.f -side top -fill x
6156     button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
6157     pack $w.ok -side left -fill x -padx 20 -pady 20
6158     button $w.cancel -text Cancel -command "destroy $w"
6159     pack $w.cancel -side right -fill x -padx 20 -pady 20
6160     bind $w <Visibility> "grab $w; focus $w"
6161     tkwait window $w
6162     if {!$confirm_ok} return
6163     if {[catch {set fd [open \
6164             [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6165         error_popup $err
6166     } else {
6167         dohidelocalchanges
6168         set w ".resetprogress"
6169         filerun $fd [list readresetstat $fd $w]
6170         toplevel $w
6171         wm transient $w
6172         wm title $w "Reset progress"
6173         message $w.m -text "Reset in progress, please wait..." \
6174             -justify center -aspect 1000
6175         pack $w.m -side top -fill x -padx 20 -pady 5
6176         canvas $w.c -width 150 -height 20 -bg white
6177         $w.c create rect 0 0 0 20 -fill green -tags rect
6178         pack $w.c -side top -fill x -padx 20 -pady 5 -expand 1
6179         nowbusy reset
6180     }
6181 }
6182
6183 proc readresetstat {fd w} {
6184     global mainhead mainheadid showlocalchanges
6185
6186     if {[gets $fd line] >= 0} {
6187         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
6188             set x [expr {($m * 150) / $n}]
6189             $w.c coords rect 0 0 $x 20
6190         }
6191         return 1
6192     }
6193     destroy $w
6194     notbusy reset
6195     if {[catch {close $fd} err]} {
6196         error_popup $err
6197     }
6198     set oldhead $mainheadid
6199     set newhead [exec git rev-parse HEAD]
6200     if {$newhead ne $oldhead} {
6201         movehead $newhead $mainhead
6202         movedhead $newhead $mainhead
6203         set mainheadid $newhead
6204         redrawtags $oldhead
6205         redrawtags $newhead
6206     }
6207     if {$showlocalchanges} {
6208         doshowlocalchanges
6209     }
6210     return 0
6211 }
6212
6213 # context menu for a head
6214 proc headmenu {x y id head} {
6215     global headmenuid headmenuhead headctxmenu mainhead
6216
6217     set headmenuid $id
6218     set headmenuhead $head
6219     set state normal
6220     if {$head eq $mainhead} {
6221         set state disabled
6222     }
6223     $headctxmenu entryconfigure 0 -state $state
6224     $headctxmenu entryconfigure 1 -state $state
6225     tk_popup $headctxmenu $x $y
6226 }
6227
6228 proc cobranch {} {
6229     global headmenuid headmenuhead mainhead headids
6230     global showlocalchanges mainheadid
6231
6232     # check the tree is clean first??
6233     set oldmainhead $mainhead
6234     nowbusy checkout
6235     update
6236     dohidelocalchanges
6237     if {[catch {
6238         exec git checkout -q $headmenuhead
6239     } err]} {
6240         notbusy checkout
6241         error_popup $err
6242     } else {
6243         notbusy checkout
6244         set mainhead $headmenuhead
6245         set mainheadid $headmenuid
6246         if {[info exists headids($oldmainhead)]} {
6247             redrawtags $headids($oldmainhead)
6248         }
6249         redrawtags $headmenuid
6250     }
6251     if {$showlocalchanges} {
6252         dodiffindex
6253     }
6254 }
6255
6256 proc rmbranch {} {
6257     global headmenuid headmenuhead mainhead
6258     global idheads
6259
6260     set head $headmenuhead
6261     set id $headmenuid
6262     # this check shouldn't be needed any more...
6263     if {$head eq $mainhead} {
6264         error_popup "Cannot delete the currently checked-out branch"
6265         return
6266     }
6267     set dheads [descheads $id]
6268     if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
6269         # the stuff on this branch isn't on any other branch
6270         if {![confirm_popup "The commits on branch $head aren't on any other\
6271                         branch.\nReally delete branch $head?"]} return
6272     }
6273     nowbusy rmbranch
6274     update
6275     if {[catch {exec git branch -D $head} err]} {
6276         notbusy rmbranch
6277         error_popup $err
6278         return
6279     }
6280     removehead $id $head
6281     removedhead $id $head
6282     redrawtags $id
6283     notbusy rmbranch
6284     dispneartags 0
6285     run refill_reflist
6286 }
6287
6288 # Display a list of tags and heads
6289 proc showrefs {} {
6290     global showrefstop bgcolor fgcolor selectbgcolor mainfont
6291     global bglist fglist uifont reflistfilter reflist maincursor
6292
6293     set top .showrefs
6294     set showrefstop $top
6295     if {[winfo exists $top]} {
6296         raise $top
6297         refill_reflist
6298         return
6299     }
6300     toplevel $top
6301     wm title $top "Tags and heads: [file tail [pwd]]"
6302     text $top.list -background $bgcolor -foreground $fgcolor \
6303         -selectbackground $selectbgcolor -font $mainfont \
6304         -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
6305         -width 30 -height 20 -cursor $maincursor \
6306         -spacing1 1 -spacing3 1 -state disabled
6307     $top.list tag configure highlight -background $selectbgcolor
6308     lappend bglist $top.list
6309     lappend fglist $top.list
6310     scrollbar $top.ysb -command "$top.list yview" -orient vertical
6311     scrollbar $top.xsb -command "$top.list xview" -orient horizontal
6312     grid $top.list $top.ysb -sticky nsew
6313     grid $top.xsb x -sticky ew
6314     frame $top.f
6315     label $top.f.l -text "Filter: " -font $uifont
6316     entry $top.f.e -width 20 -textvariable reflistfilter -font $uifont
6317     set reflistfilter "*"
6318     trace add variable reflistfilter write reflistfilter_change
6319     pack $top.f.e -side right -fill x -expand 1
6320     pack $top.f.l -side left
6321     grid $top.f - -sticky ew -pady 2
6322     button $top.close -command [list destroy $top] -text "Close" \
6323         -font $uifont
6324     grid $top.close -
6325     grid columnconfigure $top 0 -weight 1
6326     grid rowconfigure $top 0 -weight 1
6327     bind $top.list <1> {break}
6328     bind $top.list <B1-Motion> {break}
6329     bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
6330     set reflist {}
6331     refill_reflist
6332 }
6333
6334 proc sel_reflist {w x y} {
6335     global showrefstop reflist headids tagids otherrefids
6336
6337     if {![winfo exists $showrefstop]} return
6338     set l [lindex [split [$w index "@$x,$y"] "."] 0]
6339     set ref [lindex $reflist [expr {$l-1}]]
6340     set n [lindex $ref 0]
6341     switch -- [lindex $ref 1] {
6342         "H" {selbyid $headids($n)}
6343         "T" {selbyid $tagids($n)}
6344         "o" {selbyid $otherrefids($n)}
6345     }
6346     $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
6347 }
6348
6349 proc unsel_reflist {} {
6350     global showrefstop
6351
6352     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6353     $showrefstop.list tag remove highlight 0.0 end
6354 }
6355
6356 proc reflistfilter_change {n1 n2 op} {
6357     global reflistfilter
6358
6359     after cancel refill_reflist
6360     after 200 refill_reflist
6361 }
6362
6363 proc refill_reflist {} {
6364     global reflist reflistfilter showrefstop headids tagids otherrefids
6365     global commitrow curview commitinterest
6366
6367     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6368     set refs {}
6369     foreach n [array names headids] {
6370         if {[string match $reflistfilter $n]} {
6371             if {[info exists commitrow($curview,$headids($n))]} {
6372                 lappend refs [list $n H]
6373             } else {
6374                 set commitinterest($headids($n)) {run refill_reflist}
6375             }
6376         }
6377     }
6378     foreach n [array names tagids] {
6379         if {[string match $reflistfilter $n]} {
6380             if {[info exists commitrow($curview,$tagids($n))]} {
6381                 lappend refs [list $n T]
6382             } else {
6383                 set commitinterest($tagids($n)) {run refill_reflist}
6384             }
6385         }
6386     }
6387     foreach n [array names otherrefids] {
6388         if {[string match $reflistfilter $n]} {
6389             if {[info exists commitrow($curview,$otherrefids($n))]} {
6390                 lappend refs [list $n o]
6391             } else {
6392                 set commitinterest($otherrefids($n)) {run refill_reflist}
6393             }
6394         }
6395     }
6396     set refs [lsort -index 0 $refs]
6397     if {$refs eq $reflist} return
6398
6399     # Update the contents of $showrefstop.list according to the
6400     # differences between $reflist (old) and $refs (new)
6401     $showrefstop.list conf -state normal
6402     $showrefstop.list insert end "\n"
6403     set i 0
6404     set j 0
6405     while {$i < [llength $reflist] || $j < [llength $refs]} {
6406         if {$i < [llength $reflist]} {
6407             if {$j < [llength $refs]} {
6408                 set cmp [string compare [lindex $reflist $i 0] \
6409                              [lindex $refs $j 0]]
6410                 if {$cmp == 0} {
6411                     set cmp [string compare [lindex $reflist $i 1] \
6412                                  [lindex $refs $j 1]]
6413                 }
6414             } else {
6415                 set cmp -1
6416             }
6417         } else {
6418             set cmp 1
6419         }
6420         switch -- $cmp {
6421             -1 {
6422                 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
6423                 incr i
6424             }
6425             0 {
6426                 incr i
6427                 incr j
6428             }
6429             1 {
6430                 set l [expr {$j + 1}]
6431                 $showrefstop.list image create $l.0 -align baseline \
6432                     -image reficon-[lindex $refs $j 1] -padx 2
6433                 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
6434                 incr j
6435             }
6436         }
6437     }
6438     set reflist $refs
6439     # delete last newline
6440     $showrefstop.list delete end-2c end-1c
6441     $showrefstop.list conf -state disabled
6442 }
6443
6444 # Stuff for finding nearby tags
6445 proc getallcommits {} {
6446     global allcommits allids nbmp nextarc seeds
6447
6448     if {![info exists allcommits]} {
6449         set allids {}
6450         set nbmp 0
6451         set nextarc 0
6452         set allcommits 0
6453         set seeds {}
6454     }
6455
6456     set cmd [concat | git rev-list --all --parents]
6457     foreach id $seeds {
6458         lappend cmd "^$id"
6459     }
6460     set fd [open $cmd r]
6461     fconfigure $fd -blocking 0
6462     incr allcommits
6463     nowbusy allcommits
6464     filerun $fd [list getallclines $fd]
6465 }
6466
6467 # Since most commits have 1 parent and 1 child, we group strings of
6468 # such commits into "arcs" joining branch/merge points (BMPs), which
6469 # are commits that either don't have 1 parent or don't have 1 child.
6470 #
6471 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6472 # arcout(id) - outgoing arcs for BMP
6473 # arcids(a) - list of IDs on arc including end but not start
6474 # arcstart(a) - BMP ID at start of arc
6475 # arcend(a) - BMP ID at end of arc
6476 # growing(a) - arc a is still growing
6477 # arctags(a) - IDs out of arcids (excluding end) that have tags
6478 # archeads(a) - IDs out of arcids (excluding end) that have heads
6479 # The start of an arc is at the descendent end, so "incoming" means
6480 # coming from descendents, and "outgoing" means going towards ancestors.
6481
6482 proc getallclines {fd} {
6483     global allids allparents allchildren idtags idheads nextarc nbmp
6484     global arcnos arcids arctags arcout arcend arcstart archeads growing
6485     global seeds allcommits
6486
6487     set nid 0
6488     while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6489         set id [lindex $line 0]
6490         if {[info exists allparents($id)]} {
6491             # seen it already
6492             continue
6493         }
6494         lappend allids $id
6495         set olds [lrange $line 1 end]
6496         set allparents($id) $olds
6497         if {![info exists allchildren($id)]} {
6498             set allchildren($id) {}
6499             set arcnos($id) {}
6500             lappend seeds $id
6501         } else {
6502             set a $arcnos($id)
6503             if {[llength $olds] == 1 && [llength $a] == 1} {
6504                 lappend arcids($a) $id
6505                 if {[info exists idtags($id)]} {
6506                     lappend arctags($a) $id
6507                 }
6508                 if {[info exists idheads($id)]} {
6509                     lappend archeads($a) $id
6510                 }
6511                 if {[info exists allparents($olds)]} {
6512                     # seen parent already
6513                     if {![info exists arcout($olds)]} {
6514                         splitarc $olds
6515                     }
6516                     lappend arcids($a) $olds
6517                     set arcend($a) $olds
6518                     unset growing($a)
6519                 }
6520                 lappend allchildren($olds) $id
6521                 lappend arcnos($olds) $a
6522                 continue
6523             }
6524         }
6525         incr nbmp
6526         foreach a $arcnos($id) {
6527             lappend arcids($a) $id
6528             set arcend($a) $id
6529             unset growing($a)
6530         }
6531
6532         set ao {}
6533         foreach p $olds {
6534             lappend allchildren($p) $id
6535             set a [incr nextarc]
6536             set arcstart($a) $id
6537             set archeads($a) {}
6538             set arctags($a) {}
6539             set archeads($a) {}
6540             set arcids($a) {}
6541             lappend ao $a
6542             set growing($a) 1
6543             if {[info exists allparents($p)]} {
6544                 # seen it already, may need to make a new branch
6545                 if {![info exists arcout($p)]} {
6546                     splitarc $p
6547                 }
6548                 lappend arcids($a) $p
6549                 set arcend($a) $p
6550                 unset growing($a)
6551             }
6552             lappend arcnos($p) $a
6553         }
6554         set arcout($id) $ao
6555     }
6556     if {$nid > 0} {
6557         global cached_dheads cached_dtags cached_atags
6558         catch {unset cached_dheads}
6559         catch {unset cached_dtags}
6560         catch {unset cached_atags}
6561     }
6562     if {![eof $fd]} {
6563         return [expr {$nid >= 1000? 2: 1}]
6564     }
6565     close $fd
6566     if {[incr allcommits -1] == 0} {
6567         notbusy allcommits
6568     }
6569     dispneartags 0
6570     return 0
6571 }
6572
6573 proc recalcarc {a} {
6574     global arctags archeads arcids idtags idheads
6575
6576     set at {}
6577     set ah {}
6578     foreach id [lrange $arcids($a) 0 end-1] {
6579         if {[info exists idtags($id)]} {
6580             lappend at $id
6581         }
6582         if {[info exists idheads($id)]} {
6583             lappend ah $id
6584         }
6585     }
6586     set arctags($a) $at
6587     set archeads($a) $ah
6588 }
6589
6590 proc splitarc {p} {
6591     global arcnos arcids nextarc nbmp arctags archeads idtags idheads
6592     global arcstart arcend arcout allparents growing
6593
6594     set a $arcnos($p)
6595     if {[llength $a] != 1} {
6596         puts "oops splitarc called but [llength $a] arcs already"
6597         return
6598     }
6599     set a [lindex $a 0]
6600     set i [lsearch -exact $arcids($a) $p]
6601     if {$i < 0} {
6602         puts "oops splitarc $p not in arc $a"
6603         return
6604     }
6605     set na [incr nextarc]
6606     if {[info exists arcend($a)]} {
6607         set arcend($na) $arcend($a)
6608     } else {
6609         set l [lindex $allparents([lindex $arcids($a) end]) 0]
6610         set j [lsearch -exact $arcnos($l) $a]
6611         set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6612     }
6613     set tail [lrange $arcids($a) [expr {$i+1}] end]
6614     set arcids($a) [lrange $arcids($a) 0 $i]
6615     set arcend($a) $p
6616     set arcstart($na) $p
6617     set arcout($p) $na
6618     set arcids($na) $tail
6619     if {[info exists growing($a)]} {
6620         set growing($na) 1
6621         unset growing($a)
6622     }
6623     incr nbmp
6624
6625     foreach id $tail {
6626         if {[llength $arcnos($id)] == 1} {
6627             set arcnos($id) $na
6628         } else {
6629             set j [lsearch -exact $arcnos($id) $a]
6630             set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6631         }
6632     }
6633
6634     # reconstruct tags and heads lists
6635     if {$arctags($a) ne {} || $archeads($a) ne {}} {
6636         recalcarc $a
6637         recalcarc $na
6638     } else {
6639         set arctags($na) {}
6640         set archeads($na) {}
6641     }
6642 }
6643
6644 # Update things for a new commit added that is a child of one
6645 # existing commit.  Used when cherry-picking.
6646 proc addnewchild {id p} {
6647     global allids allparents allchildren idtags nextarc nbmp
6648     global arcnos arcids arctags arcout arcend arcstart archeads growing
6649     global seeds allcommits
6650
6651     if {![info exists allcommits] || ![info exists arcnos($p)]} return
6652     lappend allids $id
6653     set allparents($id) [list $p]
6654     set allchildren($id) {}
6655     set arcnos($id) {}
6656     lappend seeds $id
6657     incr nbmp
6658     lappend allchildren($p) $id
6659     set a [incr nextarc]
6660     set arcstart($a) $id
6661     set archeads($a) {}
6662     set arctags($a) {}
6663     set arcids($a) [list $p]
6664     set arcend($a) $p
6665     if {![info exists arcout($p)]} {
6666         splitarc $p
6667     }
6668     lappend arcnos($p) $a
6669     set arcout($id) [list $a]
6670 }
6671
6672 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
6673 # or 0 if neither is true.
6674 proc anc_or_desc {a b} {
6675     global arcout arcstart arcend arcnos cached_isanc
6676
6677     if {$arcnos($a) eq $arcnos($b)} {
6678         # Both are on the same arc(s); either both are the same BMP,
6679         # or if one is not a BMP, the other is also not a BMP or is
6680         # the BMP at end of the arc (and it only has 1 incoming arc).
6681         # Or both can be BMPs with no incoming arcs.
6682         if {$a eq $b || $arcnos($a) eq {}} {
6683             return 0
6684         }
6685         # assert {[llength $arcnos($a)] == 1}
6686         set arc [lindex $arcnos($a) 0]
6687         set i [lsearch -exact $arcids($arc) $a]
6688         set j [lsearch -exact $arcids($arc) $b]
6689         if {$i < 0 || $i > $j} {
6690             return 1
6691         } else {
6692             return -1
6693         }
6694     }
6695
6696     if {![info exists arcout($a)]} {
6697         set arc [lindex $arcnos($a) 0]
6698         if {[info exists arcend($arc)]} {
6699             set aend $arcend($arc)
6700         } else {
6701             set aend {}
6702         }
6703         set a $arcstart($arc)
6704     } else {
6705         set aend $a
6706     }
6707     if {![info exists arcout($b)]} {
6708         set arc [lindex $arcnos($b) 0]
6709         if {[info exists arcend($arc)]} {
6710             set bend $arcend($arc)
6711         } else {
6712             set bend {}
6713         }
6714         set b $arcstart($arc)
6715     } else {
6716         set bend $b
6717     }
6718     if {$a eq $bend} {
6719         return 1
6720     }
6721     if {$b eq $aend} {
6722         return -1
6723     }
6724     if {[info exists cached_isanc($a,$bend)]} {
6725         if {$cached_isanc($a,$bend)} {
6726             return 1
6727         }
6728     }
6729     if {[info exists cached_isanc($b,$aend)]} {
6730         if {$cached_isanc($b,$aend)} {
6731             return -1
6732         }
6733         if {[info exists cached_isanc($a,$bend)]} {
6734             return 0
6735         }
6736     }
6737
6738     set todo [list $a $b]
6739     set anc($a) a
6740     set anc($b) b
6741     for {set i 0} {$i < [llength $todo]} {incr i} {
6742         set x [lindex $todo $i]
6743         if {$anc($x) eq {}} {
6744             continue
6745         }
6746         foreach arc $arcnos($x) {
6747             set xd $arcstart($arc)
6748             if {$xd eq $bend} {
6749                 set cached_isanc($a,$bend) 1
6750                 set cached_isanc($b,$aend) 0
6751                 return 1
6752             } elseif {$xd eq $aend} {
6753                 set cached_isanc($b,$aend) 1
6754                 set cached_isanc($a,$bend) 0
6755                 return -1
6756             }
6757             if {![info exists anc($xd)]} {
6758                 set anc($xd) $anc($x)
6759                 lappend todo $xd
6760             } elseif {$anc($xd) ne $anc($x)} {
6761                 set anc($xd) {}
6762             }
6763         }
6764     }
6765     set cached_isanc($a,$bend) 0
6766     set cached_isanc($b,$aend) 0
6767     return 0
6768 }
6769
6770 # This identifies whether $desc has an ancestor that is
6771 # a growing tip of the graph and which is not an ancestor of $anc
6772 # and returns 0 if so and 1 if not.
6773 # If we subsequently discover a tag on such a growing tip, and that
6774 # turns out to be a descendent of $anc (which it could, since we
6775 # don't necessarily see children before parents), then $desc
6776 # isn't a good choice to display as a descendent tag of
6777 # $anc (since it is the descendent of another tag which is
6778 # a descendent of $anc).  Similarly, $anc isn't a good choice to
6779 # display as a ancestor tag of $desc.
6780 #
6781 proc is_certain {desc anc} {
6782     global arcnos arcout arcstart arcend growing problems
6783
6784     set certain {}
6785     if {[llength $arcnos($anc)] == 1} {
6786         # tags on the same arc are certain
6787         if {$arcnos($desc) eq $arcnos($anc)} {
6788             return 1
6789         }
6790         if {![info exists arcout($anc)]} {
6791             # if $anc is partway along an arc, use the start of the arc instead
6792             set a [lindex $arcnos($anc) 0]
6793             set anc $arcstart($a)
6794         }
6795     }
6796     if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
6797         set x $desc
6798     } else {
6799         set a [lindex $arcnos($desc) 0]
6800         set x $arcend($a)
6801     }
6802     if {$x == $anc} {
6803         return 1
6804     }
6805     set anclist [list $x]
6806     set dl($x) 1
6807     set nnh 1
6808     set ngrowanc 0
6809     for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
6810         set x [lindex $anclist $i]
6811         if {$dl($x)} {
6812             incr nnh -1
6813         }
6814         set done($x) 1
6815         foreach a $arcout($x) {
6816             if {[info exists growing($a)]} {
6817                 if {![info exists growanc($x)] && $dl($x)} {
6818                     set growanc($x) 1
6819                     incr ngrowanc
6820                 }
6821             } else {
6822                 set y $arcend($a)
6823                 if {[info exists dl($y)]} {
6824                     if {$dl($y)} {
6825                         if {!$dl($x)} {
6826                             set dl($y) 0
6827                             if {![info exists done($y)]} {
6828                                 incr nnh -1
6829                             }
6830                             if {[info exists growanc($x)]} {
6831                                 incr ngrowanc -1
6832                             }
6833                             set xl [list $y]
6834                             for {set k 0} {$k < [llength $xl]} {incr k} {
6835                                 set z [lindex $xl $k]
6836                                 foreach c $arcout($z) {
6837                                     if {[info exists arcend($c)]} {
6838                                         set v $arcend($c)
6839                                         if {[info exists dl($v)] && $dl($v)} {
6840                                             set dl($v) 0
6841                                             if {![info exists done($v)]} {
6842                                                 incr nnh -1
6843                                             }
6844                                             if {[info exists growanc($v)]} {
6845                                                 incr ngrowanc -1
6846                                             }
6847                                             lappend xl $v
6848                                         }
6849                                     }
6850                                 }
6851                             }
6852                         }
6853                     }
6854                 } elseif {$y eq $anc || !$dl($x)} {
6855                     set dl($y) 0
6856                     lappend anclist $y
6857                 } else {
6858                     set dl($y) 1
6859                     lappend anclist $y
6860                     incr nnh
6861                 }
6862             }
6863         }
6864     }
6865     foreach x [array names growanc] {
6866         if {$dl($x)} {
6867             return 0
6868         }
6869         return 0
6870     }
6871     return 1
6872 }
6873
6874 proc validate_arctags {a} {
6875     global arctags idtags
6876
6877     set i -1
6878     set na $arctags($a)
6879     foreach id $arctags($a) {
6880         incr i
6881         if {![info exists idtags($id)]} {
6882             set na [lreplace $na $i $i]
6883             incr i -1
6884         }
6885     }
6886     set arctags($a) $na
6887 }
6888
6889 proc validate_archeads {a} {
6890     global archeads idheads
6891
6892     set i -1
6893     set na $archeads($a)
6894     foreach id $archeads($a) {
6895         incr i
6896         if {![info exists idheads($id)]} {
6897             set na [lreplace $na $i $i]
6898             incr i -1
6899         }
6900     }
6901     set archeads($a) $na
6902 }
6903
6904 # Return the list of IDs that have tags that are descendents of id,
6905 # ignoring IDs that are descendents of IDs already reported.
6906 proc desctags {id} {
6907     global arcnos arcstart arcids arctags idtags allparents
6908     global growing cached_dtags
6909
6910     if {![info exists allparents($id)]} {
6911         return {}
6912     }
6913     set t1 [clock clicks -milliseconds]
6914     set argid $id
6915     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6916         # part-way along an arc; check that arc first
6917         set a [lindex $arcnos($id) 0]
6918         if {$arctags($a) ne {}} {
6919             validate_arctags $a
6920             set i [lsearch -exact $arcids($a) $id]
6921             set tid {}
6922             foreach t $arctags($a) {
6923                 set j [lsearch -exact $arcids($a) $t]
6924                 if {$j >= $i} break
6925                 set tid $t
6926             }
6927             if {$tid ne {}} {
6928                 return $tid
6929             }
6930         }
6931         set id $arcstart($a)
6932         if {[info exists idtags($id)]} {
6933             return $id
6934         }
6935     }
6936     if {[info exists cached_dtags($id)]} {
6937         return $cached_dtags($id)
6938     }
6939
6940     set origid $id
6941     set todo [list $id]
6942     set queued($id) 1
6943     set nc 1
6944     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6945         set id [lindex $todo $i]
6946         set done($id) 1
6947         set ta [info exists hastaggedancestor($id)]
6948         if {!$ta} {
6949             incr nc -1
6950         }
6951         # ignore tags on starting node
6952         if {!$ta && $i > 0} {
6953             if {[info exists idtags($id)]} {
6954                 set tagloc($id) $id
6955                 set ta 1
6956             } elseif {[info exists cached_dtags($id)]} {
6957                 set tagloc($id) $cached_dtags($id)
6958                 set ta 1
6959             }
6960         }
6961         foreach a $arcnos($id) {
6962             set d $arcstart($a)
6963             if {!$ta && $arctags($a) ne {}} {
6964                 validate_arctags $a
6965                 if {$arctags($a) ne {}} {
6966                     lappend tagloc($id) [lindex $arctags($a) end]
6967                 }
6968             }
6969             if {$ta || $arctags($a) ne {}} {
6970                 set tomark [list $d]
6971                 for {set j 0} {$j < [llength $tomark]} {incr j} {
6972                     set dd [lindex $tomark $j]
6973                     if {![info exists hastaggedancestor($dd)]} {
6974                         if {[info exists done($dd)]} {
6975                             foreach b $arcnos($dd) {
6976                                 lappend tomark $arcstart($b)
6977                             }
6978                             if {[info exists tagloc($dd)]} {
6979                                 unset tagloc($dd)
6980                             }
6981                         } elseif {[info exists queued($dd)]} {
6982                             incr nc -1
6983                         }
6984                         set hastaggedancestor($dd) 1
6985                     }
6986                 }
6987             }
6988             if {![info exists queued($d)]} {
6989                 lappend todo $d
6990                 set queued($d) 1
6991                 if {![info exists hastaggedancestor($d)]} {
6992                     incr nc
6993                 }
6994             }
6995         }
6996     }
6997     set tags {}
6998     foreach id [array names tagloc] {
6999         if {![info exists hastaggedancestor($id)]} {
7000             foreach t $tagloc($id) {
7001                 if {[lsearch -exact $tags $t] < 0} {
7002                     lappend tags $t
7003                 }
7004             }
7005         }
7006     }
7007     set t2 [clock clicks -milliseconds]
7008     set loopix $i
7009
7010     # remove tags that are descendents of other tags
7011     for {set i 0} {$i < [llength $tags]} {incr i} {
7012         set a [lindex $tags $i]
7013         for {set j 0} {$j < $i} {incr j} {
7014             set b [lindex $tags $j]
7015             set r [anc_or_desc $a $b]
7016             if {$r == 1} {
7017                 set tags [lreplace $tags $j $j]
7018                 incr j -1
7019                 incr i -1
7020             } elseif {$r == -1} {
7021                 set tags [lreplace $tags $i $i]
7022                 incr i -1
7023                 break
7024             }
7025         }
7026     }
7027
7028     if {[array names growing] ne {}} {
7029         # graph isn't finished, need to check if any tag could get
7030         # eclipsed by another tag coming later.  Simply ignore any
7031         # tags that could later get eclipsed.
7032         set ctags {}
7033         foreach t $tags {
7034             if {[is_certain $t $origid]} {
7035                 lappend ctags $t
7036             }
7037         }
7038         if {$tags eq $ctags} {
7039             set cached_dtags($origid) $tags
7040         } else {
7041             set tags $ctags
7042         }
7043     } else {
7044         set cached_dtags($origid) $tags
7045     }
7046     set t3 [clock clicks -milliseconds]
7047     if {0 && $t3 - $t1 >= 100} {
7048         puts "iterating descendents ($loopix/[llength $todo] nodes) took\
7049             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7050     }
7051     return $tags
7052 }
7053
7054 proc anctags {id} {
7055     global arcnos arcids arcout arcend arctags idtags allparents
7056     global growing cached_atags
7057
7058     if {![info exists allparents($id)]} {
7059         return {}
7060     }
7061     set t1 [clock clicks -milliseconds]
7062     set argid $id
7063     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7064         # part-way along an arc; check that arc first
7065         set a [lindex $arcnos($id) 0]
7066         if {$arctags($a) ne {}} {
7067             validate_arctags $a
7068             set i [lsearch -exact $arcids($a) $id]
7069             foreach t $arctags($a) {
7070                 set j [lsearch -exact $arcids($a) $t]
7071                 if {$j > $i} {
7072                     return $t
7073                 }
7074             }
7075         }
7076         if {![info exists arcend($a)]} {
7077             return {}
7078         }
7079         set id $arcend($a)
7080         if {[info exists idtags($id)]} {
7081             return $id
7082         }
7083     }
7084     if {[info exists cached_atags($id)]} {
7085         return $cached_atags($id)
7086     }
7087
7088     set origid $id
7089     set todo [list $id]
7090     set queued($id) 1
7091     set taglist {}
7092     set nc 1
7093     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7094         set id [lindex $todo $i]
7095         set done($id) 1
7096         set td [info exists hastaggeddescendent($id)]
7097         if {!$td} {
7098             incr nc -1
7099         }
7100         # ignore tags on starting node
7101         if {!$td && $i > 0} {
7102             if {[info exists idtags($id)]} {
7103                 set tagloc($id) $id
7104                 set td 1
7105             } elseif {[info exists cached_atags($id)]} {
7106                 set tagloc($id) $cached_atags($id)
7107                 set td 1
7108             }
7109         }
7110         foreach a $arcout($id) {
7111             if {!$td && $arctags($a) ne {}} {
7112                 validate_arctags $a
7113                 if {$arctags($a) ne {}} {
7114                     lappend tagloc($id) [lindex $arctags($a) 0]
7115                 }
7116             }
7117             if {![info exists arcend($a)]} continue
7118             set d $arcend($a)
7119             if {$td || $arctags($a) ne {}} {
7120                 set tomark [list $d]
7121                 for {set j 0} {$j < [llength $tomark]} {incr j} {
7122                     set dd [lindex $tomark $j]
7123                     if {![info exists hastaggeddescendent($dd)]} {
7124                         if {[info exists done($dd)]} {
7125                             foreach b $arcout($dd) {
7126                                 if {[info exists arcend($b)]} {
7127                                     lappend tomark $arcend($b)
7128                                 }
7129                             }
7130                             if {[info exists tagloc($dd)]} {
7131                                 unset tagloc($dd)
7132                             }
7133                         } elseif {[info exists queued($dd)]} {
7134                             incr nc -1
7135                         }
7136                         set hastaggeddescendent($dd) 1
7137                     }
7138                 }
7139             }
7140             if {![info exists queued($d)]} {
7141                 lappend todo $d
7142                 set queued($d) 1
7143                 if {![info exists hastaggeddescendent($d)]} {
7144                     incr nc
7145                 }
7146             }
7147         }
7148     }
7149     set t2 [clock clicks -milliseconds]
7150     set loopix $i
7151     set tags {}
7152     foreach id [array names tagloc] {
7153         if {![info exists hastaggeddescendent($id)]} {
7154             foreach t $tagloc($id) {
7155                 if {[lsearch -exact $tags $t] < 0} {
7156                     lappend tags $t
7157                 }
7158             }
7159         }
7160     }
7161
7162     # remove tags that are ancestors of other tags
7163     for {set i 0} {$i < [llength $tags]} {incr i} {
7164         set a [lindex $tags $i]
7165         for {set j 0} {$j < $i} {incr j} {
7166             set b [lindex $tags $j]
7167             set r [anc_or_desc $a $b]
7168             if {$r == -1} {
7169                 set tags [lreplace $tags $j $j]
7170                 incr j -1
7171                 incr i -1
7172             } elseif {$r == 1} {
7173                 set tags [lreplace $tags $i $i]
7174                 incr i -1
7175                 break
7176             }
7177         }
7178     }
7179
7180     if {[array names growing] ne {}} {
7181         # graph isn't finished, need to check if any tag could get
7182         # eclipsed by another tag coming later.  Simply ignore any
7183         # tags that could later get eclipsed.
7184         set ctags {}
7185         foreach t $tags {
7186             if {[is_certain $origid $t]} {
7187                 lappend ctags $t
7188             }
7189         }
7190         if {$tags eq $ctags} {
7191             set cached_atags($origid) $tags
7192         } else {
7193             set tags $ctags
7194         }
7195     } else {
7196         set cached_atags($origid) $tags
7197     }
7198     set t3 [clock clicks -milliseconds]
7199     if {0 && $t3 - $t1 >= 100} {
7200         puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
7201             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7202     }
7203     return $tags
7204 }
7205
7206 # Return the list of IDs that have heads that are descendents of id,
7207 # including id itself if it has a head.
7208 proc descheads {id} {
7209     global arcnos arcstart arcids archeads idheads cached_dheads
7210     global allparents
7211
7212     if {![info exists allparents($id)]} {
7213         return {}
7214     }
7215     set aret {}
7216     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7217         # part-way along an arc; check it first
7218         set a [lindex $arcnos($id) 0]
7219         if {$archeads($a) ne {}} {
7220             validate_archeads $a
7221             set i [lsearch -exact $arcids($a) $id]
7222             foreach t $archeads($a) {
7223                 set j [lsearch -exact $arcids($a) $t]
7224                 if {$j > $i} break
7225                 lappend aret $t
7226             }
7227         }
7228         set id $arcstart($a)
7229     }
7230     set origid $id
7231     set todo [list $id]
7232     set seen($id) 1
7233     set ret {}
7234     for {set i 0} {$i < [llength $todo]} {incr i} {
7235         set id [lindex $todo $i]
7236         if {[info exists cached_dheads($id)]} {
7237             set ret [concat $ret $cached_dheads($id)]
7238         } else {
7239             if {[info exists idheads($id)]} {
7240                 lappend ret $id
7241             }
7242             foreach a $arcnos($id) {
7243                 if {$archeads($a) ne {}} {
7244                     validate_archeads $a
7245                     if {$archeads($a) ne {}} {
7246                         set ret [concat $ret $archeads($a)]
7247                     }
7248                 }
7249                 set d $arcstart($a)
7250                 if {![info exists seen($d)]} {
7251                     lappend todo $d
7252                     set seen($d) 1
7253                 }
7254             }
7255         }
7256     }
7257     set ret [lsort -unique $ret]
7258     set cached_dheads($origid) $ret
7259     return [concat $ret $aret]
7260 }
7261
7262 proc addedtag {id} {
7263     global arcnos arcout cached_dtags cached_atags
7264
7265     if {![info exists arcnos($id)]} return
7266     if {![info exists arcout($id)]} {
7267         recalcarc [lindex $arcnos($id) 0]
7268     }
7269     catch {unset cached_dtags}
7270     catch {unset cached_atags}
7271 }
7272
7273 proc addedhead {hid head} {
7274     global arcnos arcout cached_dheads
7275
7276     if {![info exists arcnos($hid)]} return
7277     if {![info exists arcout($hid)]} {
7278         recalcarc [lindex $arcnos($hid) 0]
7279     }
7280     catch {unset cached_dheads}
7281 }
7282
7283 proc removedhead {hid head} {
7284     global cached_dheads
7285
7286     catch {unset cached_dheads}
7287 }
7288
7289 proc movedhead {hid head} {
7290     global arcnos arcout cached_dheads
7291
7292     if {![info exists arcnos($hid)]} return
7293     if {![info exists arcout($hid)]} {
7294         recalcarc [lindex $arcnos($hid) 0]
7295     }
7296     catch {unset cached_dheads}
7297 }
7298
7299 proc changedrefs {} {
7300     global cached_dheads cached_dtags cached_atags
7301     global arctags archeads arcnos arcout idheads idtags
7302
7303     foreach id [concat [array names idheads] [array names idtags]] {
7304         if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
7305             set a [lindex $arcnos($id) 0]
7306             if {![info exists donearc($a)]} {
7307                 recalcarc $a
7308                 set donearc($a) 1
7309             }
7310         }
7311     }
7312     catch {unset cached_dtags}
7313     catch {unset cached_atags}
7314     catch {unset cached_dheads}
7315 }
7316
7317 proc rereadrefs {} {
7318     global idtags idheads idotherrefs mainhead
7319
7320     set refids [concat [array names idtags] \
7321                     [array names idheads] [array names idotherrefs]]
7322     foreach id $refids {
7323         if {![info exists ref($id)]} {
7324             set ref($id) [listrefs $id]
7325         }
7326     }
7327     set oldmainhead $mainhead
7328     readrefs
7329     changedrefs
7330     set refids [lsort -unique [concat $refids [array names idtags] \
7331                         [array names idheads] [array names idotherrefs]]]
7332     foreach id $refids {
7333         set v [listrefs $id]
7334         if {![info exists ref($id)] || $ref($id) != $v ||
7335             ($id eq $oldmainhead && $id ne $mainhead) ||
7336             ($id eq $mainhead && $id ne $oldmainhead)} {
7337             redrawtags $id
7338         }
7339     }
7340     run refill_reflist
7341 }
7342
7343 proc listrefs {id} {
7344     global idtags idheads idotherrefs
7345
7346     set x {}
7347     if {[info exists idtags($id)]} {
7348         set x $idtags($id)
7349     }
7350     set y {}
7351     if {[info exists idheads($id)]} {
7352         set y $idheads($id)
7353     }
7354     set z {}
7355     if {[info exists idotherrefs($id)]} {
7356         set z $idotherrefs($id)
7357     }
7358     return [list $x $y $z]
7359 }
7360
7361 proc showtag {tag isnew} {
7362     global ctext tagcontents tagids linknum tagobjid
7363
7364     if {$isnew} {
7365         addtohistory [list showtag $tag 0]
7366     }
7367     $ctext conf -state normal
7368     clear_ctext
7369     set linknum 0
7370     if {![info exists tagcontents($tag)]} {
7371         catch {
7372             set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
7373         }
7374     }
7375     if {[info exists tagcontents($tag)]} {
7376         set text $tagcontents($tag)
7377     } else {
7378         set text "Tag: $tag\nId:  $tagids($tag)"
7379     }
7380     appendwithlinks $text {}
7381     $ctext conf -state disabled
7382     init_flist {}
7383 }
7384
7385 proc doquit {} {
7386     global stopped
7387     set stopped 100
7388     savestuff .
7389     destroy .
7390 }
7391
7392 proc doprefs {} {
7393     global maxwidth maxgraphpct diffopts
7394     global oldprefs prefstop showneartags showlocalchanges
7395     global bgcolor fgcolor ctext diffcolors selectbgcolor
7396     global uifont tabstop
7397
7398     set top .gitkprefs
7399     set prefstop $top
7400     if {[winfo exists $top]} {
7401         raise $top
7402         return
7403     }
7404     foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7405         set oldprefs($v) [set $v]
7406     }
7407     toplevel $top
7408     wm title $top "Gitk preferences"
7409     label $top.ldisp -text "Commit list display options"
7410     $top.ldisp configure -font $uifont
7411     grid $top.ldisp - -sticky w -pady 10
7412     label $top.spacer -text " "
7413     label $top.maxwidthl -text "Maximum graph width (lines)" \
7414         -font optionfont
7415     spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7416     grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7417     label $top.maxpctl -text "Maximum graph width (% of pane)" \
7418         -font optionfont
7419     spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7420     grid x $top.maxpctl $top.maxpct -sticky w
7421     frame $top.showlocal
7422     label $top.showlocal.l -text "Show local changes" -font optionfont
7423     checkbutton $top.showlocal.b -variable showlocalchanges
7424     pack $top.showlocal.b $top.showlocal.l -side left
7425     grid x $top.showlocal -sticky w
7426
7427     label $top.ddisp -text "Diff display options"
7428     $top.ddisp configure -font $uifont
7429     grid $top.ddisp - -sticky w -pady 10
7430     label $top.diffoptl -text "Options for diff program" \
7431         -font optionfont
7432     entry $top.diffopt -width 20 -textvariable diffopts
7433     grid x $top.diffoptl $top.diffopt -sticky w
7434     frame $top.ntag
7435     label $top.ntag.l -text "Display nearby tags" -font optionfont
7436     checkbutton $top.ntag.b -variable showneartags
7437     pack $top.ntag.b $top.ntag.l -side left
7438     grid x $top.ntag -sticky w
7439     label $top.tabstopl -text "tabstop" -font optionfont
7440     spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7441     grid x $top.tabstopl $top.tabstop -sticky w
7442
7443     label $top.cdisp -text "Colors: press to choose"
7444     $top.cdisp configure -font $uifont
7445     grid $top.cdisp - -sticky w -pady 10
7446     label $top.bg -padx 40 -relief sunk -background $bgcolor
7447     button $top.bgbut -text "Background" -font optionfont \
7448         -command [list choosecolor bgcolor 0 $top.bg background setbg]
7449     grid x $top.bgbut $top.bg -sticky w
7450     label $top.fg -padx 40 -relief sunk -background $fgcolor
7451     button $top.fgbut -text "Foreground" -font optionfont \
7452         -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
7453     grid x $top.fgbut $top.fg -sticky w
7454     label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
7455     button $top.diffoldbut -text "Diff: old lines" -font optionfont \
7456         -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
7457                       [list $ctext tag conf d0 -foreground]]
7458     grid x $top.diffoldbut $top.diffold -sticky w
7459     label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
7460     button $top.diffnewbut -text "Diff: new lines" -font optionfont \
7461         -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
7462                       [list $ctext tag conf d1 -foreground]]
7463     grid x $top.diffnewbut $top.diffnew -sticky w
7464     label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
7465     button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
7466         -command [list choosecolor diffcolors 2 $top.hunksep \
7467                       "diff hunk header" \
7468                       [list $ctext tag conf hunksep -foreground]]
7469     grid x $top.hunksepbut $top.hunksep -sticky w
7470     label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
7471     button $top.selbgbut -text "Select bg" -font optionfont \
7472         -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
7473     grid x $top.selbgbut $top.selbgsep -sticky w
7474
7475     frame $top.buts
7476     button $top.buts.ok -text "OK" -command prefsok -default active
7477     $top.buts.ok configure -font $uifont
7478     button $top.buts.can -text "Cancel" -command prefscan -default normal
7479     $top.buts.can configure -font $uifont
7480     grid $top.buts.ok $top.buts.can
7481     grid columnconfigure $top.buts 0 -weight 1 -uniform a
7482     grid columnconfigure $top.buts 1 -weight 1 -uniform a
7483     grid $top.buts - - -pady 10 -sticky ew
7484     bind $top <Visibility> "focus $top.buts.ok"
7485 }
7486
7487 proc choosecolor {v vi w x cmd} {
7488     global $v
7489
7490     set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
7491                -title "Gitk: choose color for $x"]
7492     if {$c eq {}} return
7493     $w conf -background $c
7494     lset $v $vi $c
7495     eval $cmd $c
7496 }
7497
7498 proc setselbg {c} {
7499     global bglist cflist
7500     foreach w $bglist {
7501         $w configure -selectbackground $c
7502     }
7503     $cflist tag configure highlight \
7504         -background [$cflist cget -selectbackground]
7505     allcanvs itemconf secsel -fill $c
7506 }
7507
7508 proc setbg {c} {
7509     global bglist
7510
7511     foreach w $bglist {
7512         $w conf -background $c
7513     }
7514 }
7515
7516 proc setfg {c} {
7517     global fglist canv
7518
7519     foreach w $fglist {
7520         $w conf -foreground $c
7521     }
7522     allcanvs itemconf text -fill $c
7523     $canv itemconf circle -outline $c
7524 }
7525
7526 proc prefscan {} {
7527     global maxwidth maxgraphpct diffopts
7528     global oldprefs prefstop showneartags showlocalchanges
7529
7530     foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7531         set $v $oldprefs($v)
7532     }
7533     catch {destroy $prefstop}
7534     unset prefstop
7535 }
7536
7537 proc prefsok {} {
7538     global maxwidth maxgraphpct
7539     global oldprefs prefstop showneartags showlocalchanges
7540     global charspc ctext tabstop
7541
7542     catch {destroy $prefstop}
7543     unset prefstop
7544     $ctext configure -tabs "[expr {$tabstop * $charspc}]"
7545     if {$showlocalchanges != $oldprefs(showlocalchanges)} {
7546         if {$showlocalchanges} {
7547             doshowlocalchanges
7548         } else {
7549             dohidelocalchanges
7550         }
7551     }
7552     if {$maxwidth != $oldprefs(maxwidth)
7553         || $maxgraphpct != $oldprefs(maxgraphpct)} {
7554         redisplay
7555     } elseif {$showneartags != $oldprefs(showneartags)} {
7556         reselectline
7557     }
7558 }
7559
7560 proc formatdate {d} {
7561     global datetimeformat
7562     if {$d ne {}} {
7563         set d [clock format $d -format $datetimeformat]
7564     }
7565     return $d
7566 }
7567
7568 # This list of encoding names and aliases is distilled from
7569 # http://www.iana.org/assignments/character-sets.
7570 # Not all of them are supported by Tcl.
7571 set encoding_aliases {
7572     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
7573       ISO646-US US-ASCII us IBM367 cp367 csASCII }
7574     { ISO-10646-UTF-1 csISO10646UTF1 }
7575     { ISO_646.basic:1983 ref csISO646basic1983 }
7576     { INVARIANT csINVARIANT }
7577     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
7578     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
7579     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
7580     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
7581     { NATS-DANO iso-ir-9-1 csNATSDANO }
7582     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
7583     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
7584     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
7585     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
7586     { ISO-2022-KR csISO2022KR }
7587     { EUC-KR csEUCKR }
7588     { ISO-2022-JP csISO2022JP }
7589     { ISO-2022-JP-2 csISO2022JP2 }
7590     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
7591       csISO13JISC6220jp }
7592     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
7593     { IT iso-ir-15 ISO646-IT csISO15Italian }
7594     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
7595     { ES iso-ir-17 ISO646-ES csISO17Spanish }
7596     { greek7-old iso-ir-18 csISO18Greek7Old }
7597     { latin-greek iso-ir-19 csISO19LatinGreek }
7598     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
7599     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
7600     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
7601     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
7602     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
7603     { BS_viewdata iso-ir-47 csISO47BSViewdata }
7604     { INIS iso-ir-49 csISO49INIS }
7605     { INIS-8 iso-ir-50 csISO50INIS8 }
7606     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
7607     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
7608     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
7609     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
7610     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
7611     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
7612       csISO60Norwegian1 }
7613     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
7614     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
7615     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
7616     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
7617     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
7618     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
7619     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
7620     { greek7 iso-ir-88 csISO88Greek7 }
7621     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
7622     { iso-ir-90 csISO90 }
7623     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
7624     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
7625       csISO92JISC62991984b }
7626     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
7627     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
7628     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
7629       csISO95JIS62291984handadd }
7630     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
7631     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
7632     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
7633     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
7634       CP819 csISOLatin1 }
7635     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
7636     { T.61-7bit iso-ir-102 csISO102T617bit }
7637     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
7638     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
7639     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
7640     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
7641     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
7642     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
7643     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
7644     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
7645       arabic csISOLatinArabic }
7646     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
7647     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
7648     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
7649       greek greek8 csISOLatinGreek }
7650     { T.101-G2 iso-ir-128 csISO128T101G2 }
7651     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
7652       csISOLatinHebrew }
7653     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
7654     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
7655     { CSN_369103 iso-ir-139 csISO139CSN369103 }
7656     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
7657     { ISO_6937-2-add iso-ir-142 csISOTextComm }
7658     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
7659     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
7660       csISOLatinCyrillic }
7661     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
7662     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
7663     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
7664     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
7665     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
7666     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
7667     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
7668     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
7669     { ISO_10367-box iso-ir-155 csISO10367Box }
7670     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
7671     { latin-lap lap iso-ir-158 csISO158Lap }
7672     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
7673     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
7674     { us-dk csUSDK }
7675     { dk-us csDKUS }
7676     { JIS_X0201 X0201 csHalfWidthKatakana }
7677     { KSC5636 ISO646-KR csKSC5636 }
7678     { ISO-10646-UCS-2 csUnicode }
7679     { ISO-10646-UCS-4 csUCS4 }
7680     { DEC-MCS dec csDECMCS }
7681     { hp-roman8 roman8 r8 csHPRoman8 }
7682     { macintosh mac csMacintosh }
7683     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
7684       csIBM037 }
7685     { IBM038 EBCDIC-INT cp038 csIBM038 }
7686     { IBM273 CP273 csIBM273 }
7687     { IBM274 EBCDIC-BE CP274 csIBM274 }
7688     { IBM275 EBCDIC-BR cp275 csIBM275 }
7689     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
7690     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
7691     { IBM280 CP280 ebcdic-cp-it csIBM280 }
7692     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
7693     { IBM284 CP284 ebcdic-cp-es csIBM284 }
7694     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
7695     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
7696     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
7697     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
7698     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
7699     { IBM424 cp424 ebcdic-cp-he csIBM424 }
7700     { IBM437 cp437 437 csPC8CodePage437 }
7701     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
7702     { IBM775 cp775 csPC775Baltic }
7703     { IBM850 cp850 850 csPC850Multilingual }
7704     { IBM851 cp851 851 csIBM851 }
7705     { IBM852 cp852 852 csPCp852 }
7706     { IBM855 cp855 855 csIBM855 }
7707     { IBM857 cp857 857 csIBM857 }
7708     { IBM860 cp860 860 csIBM860 }
7709     { IBM861 cp861 861 cp-is csIBM861 }
7710     { IBM862 cp862 862 csPC862LatinHebrew }
7711     { IBM863 cp863 863 csIBM863 }
7712     { IBM864 cp864 csIBM864 }
7713     { IBM865 cp865 865 csIBM865 }
7714     { IBM866 cp866 866 csIBM866 }
7715     { IBM868 CP868 cp-ar csIBM868 }
7716     { IBM869 cp869 869 cp-gr csIBM869 }
7717     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
7718     { IBM871 CP871 ebcdic-cp-is csIBM871 }
7719     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
7720     { IBM891 cp891 csIBM891 }
7721     { IBM903 cp903 csIBM903 }
7722     { IBM904 cp904 904 csIBBM904 }
7723     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
7724     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
7725     { IBM1026 CP1026 csIBM1026 }
7726     { EBCDIC-AT-DE csIBMEBCDICATDE }
7727     { EBCDIC-AT-DE-A csEBCDICATDEA }
7728     { EBCDIC-CA-FR csEBCDICCAFR }
7729     { EBCDIC-DK-NO csEBCDICDKNO }
7730     { EBCDIC-DK-NO-A csEBCDICDKNOA }
7731     { EBCDIC-FI-SE csEBCDICFISE }
7732     { EBCDIC-FI-SE-A csEBCDICFISEA }
7733     { EBCDIC-FR csEBCDICFR }
7734     { EBCDIC-IT csEBCDICIT }
7735     { EBCDIC-PT csEBCDICPT }
7736     { EBCDIC-ES csEBCDICES }
7737     { EBCDIC-ES-A csEBCDICESA }
7738     { EBCDIC-ES-S csEBCDICESS }
7739     { EBCDIC-UK csEBCDICUK }
7740     { EBCDIC-US csEBCDICUS }
7741     { UNKNOWN-8BIT csUnknown8BiT }
7742     { MNEMONIC csMnemonic }
7743     { MNEM csMnem }
7744     { VISCII csVISCII }
7745     { VIQR csVIQR }
7746     { KOI8-R csKOI8R }
7747     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
7748     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
7749     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
7750     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
7751     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
7752     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
7753     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
7754     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
7755     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
7756     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
7757     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
7758     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
7759     { IBM1047 IBM-1047 }
7760     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
7761     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
7762     { UNICODE-1-1 csUnicode11 }
7763     { CESU-8 csCESU-8 }
7764     { BOCU-1 csBOCU-1 }
7765     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
7766     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
7767       l8 }
7768     { ISO-8859-15 ISO_8859-15 Latin-9 }
7769     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
7770     { GBK CP936 MS936 windows-936 }
7771     { JIS_Encoding csJISEncoding }
7772     { Shift_JIS MS_Kanji csShiftJIS }
7773     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
7774       EUC-JP }
7775     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
7776     { ISO-10646-UCS-Basic csUnicodeASCII }
7777     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
7778     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
7779     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
7780     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
7781     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
7782     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
7783     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
7784     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
7785     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
7786     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
7787     { Adobe-Standard-Encoding csAdobeStandardEncoding }
7788     { Ventura-US csVenturaUS }
7789     { Ventura-International csVenturaInternational }
7790     { PC8-Danish-Norwegian csPC8DanishNorwegian }
7791     { PC8-Turkish csPC8Turkish }
7792     { IBM-Symbols csIBMSymbols }
7793     { IBM-Thai csIBMThai }
7794     { HP-Legal csHPLegal }
7795     { HP-Pi-font csHPPiFont }
7796     { HP-Math8 csHPMath8 }
7797     { Adobe-Symbol-Encoding csHPPSMath }
7798     { HP-DeskTop csHPDesktop }
7799     { Ventura-Math csVenturaMath }
7800     { Microsoft-Publishing csMicrosoftPublishing }
7801     { Windows-31J csWindows31J }
7802     { GB2312 csGB2312 }
7803     { Big5 csBig5 }
7804 }
7805
7806 proc tcl_encoding {enc} {
7807     global encoding_aliases
7808     set names [encoding names]
7809     set lcnames [string tolower $names]
7810     set enc [string tolower $enc]
7811     set i [lsearch -exact $lcnames $enc]
7812     if {$i < 0} {
7813         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
7814         if {[regsub {^iso[-_]} $enc iso encx]} {
7815             set i [lsearch -exact $lcnames $encx]
7816         }
7817     }
7818     if {$i < 0} {
7819         foreach l $encoding_aliases {
7820             set ll [string tolower $l]
7821             if {[lsearch -exact $ll $enc] < 0} continue
7822             # look through the aliases for one that tcl knows about
7823             foreach e $ll {
7824                 set i [lsearch -exact $lcnames $e]
7825                 if {$i < 0} {
7826                     if {[regsub {^iso[-_]} $e iso ex]} {
7827                         set i [lsearch -exact $lcnames $ex]
7828                     }
7829                 }
7830                 if {$i >= 0} break
7831             }
7832             break
7833         }
7834     }
7835     if {$i >= 0} {
7836         return [lindex $names $i]
7837     }
7838     return {}
7839 }
7840
7841 # First check that Tcl/Tk is recent enough
7842 if {[catch {package require Tk 8.4} err]} {
7843     show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
7844                      Gitk requires at least Tcl/Tk 8.4."
7845     exit 1
7846 }
7847
7848 # defaults...
7849 set datemode 0
7850 set diffopts "-U 5 -p"
7851 set wrcomcmd "git diff-tree --stdin -p --pretty"
7852
7853 set gitencoding {}
7854 catch {
7855     set gitencoding [exec git config --get i18n.commitencoding]
7856 }
7857 if {$gitencoding == ""} {
7858     set gitencoding "utf-8"
7859 }
7860 set tclencoding [tcl_encoding $gitencoding]
7861 if {$tclencoding == {}} {
7862     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
7863 }
7864
7865 set mainfont {Helvetica 9}
7866 set textfont {Courier 9}
7867 set uifont {Helvetica 9 bold}
7868 set tabstop 8
7869 set findmergefiles 0
7870 set maxgraphpct 50
7871 set maxwidth 16
7872 set revlistorder 0
7873 set fastdate 0
7874 set uparrowlen 7
7875 set downarrowlen 7
7876 set mingaplen 30
7877 set cmitmode "patch"
7878 set wrapcomment "none"
7879 set showneartags 1
7880 set maxrefs 20
7881 set maxlinelen 200
7882 set showlocalchanges 1
7883 set datetimeformat "%Y-%m-%d %H:%M:%S"
7884
7885 set colors {green red blue magenta darkgrey brown orange}
7886 set bgcolor white
7887 set fgcolor black
7888 set diffcolors {red "#00a000" blue}
7889 set diffcontext 3
7890 set selectbgcolor gray85
7891
7892 catch {source ~/.gitk}
7893
7894 font create optionfont -family sans-serif -size -12
7895
7896 # check that we can find a .git directory somewhere...
7897 if {[catch {set gitdir [gitdir]}]} {
7898     show_error {} . "Cannot find a git repository here."
7899     exit 1
7900 }
7901 if {![file isdirectory $gitdir]} {
7902     show_error {} . "Cannot find the git directory \"$gitdir\"."
7903     exit 1
7904 }
7905
7906 set revtreeargs {}
7907 set cmdline_files {}
7908 set i 0
7909 foreach arg $argv {
7910     switch -- $arg {
7911         "" { }
7912         "-d" { set datemode 1 }
7913         "--" {
7914             set cmdline_files [lrange $argv [expr {$i + 1}] end]
7915             break
7916         }
7917         default {
7918             lappend revtreeargs $arg
7919         }
7920     }
7921     incr i
7922 }
7923
7924 if {$i >= [llength $argv] && $revtreeargs ne {}} {
7925     # no -- on command line, but some arguments (other than -d)
7926     if {[catch {
7927         set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
7928         set cmdline_files [split $f "\n"]
7929         set n [llength $cmdline_files]
7930         set revtreeargs [lrange $revtreeargs 0 end-$n]
7931         # Unfortunately git rev-parse doesn't produce an error when
7932         # something is both a revision and a filename.  To be consistent
7933         # with git log and git rev-list, check revtreeargs for filenames.
7934         foreach arg $revtreeargs {
7935             if {[file exists $arg]} {
7936                 show_error {} . "Ambiguous argument '$arg': both revision\
7937                                  and filename"
7938                 exit 1
7939             }
7940         }
7941     } err]} {
7942         # unfortunately we get both stdout and stderr in $err,
7943         # so look for "fatal:".
7944         set i [string first "fatal:" $err]
7945         if {$i > 0} {
7946             set err [string range $err [expr {$i + 6}] end]
7947         }
7948         show_error {} . "Bad arguments to gitk:\n$err"
7949         exit 1
7950     }
7951 }
7952
7953 set nullid "0000000000000000000000000000000000000000"
7954 set nullid2 "0000000000000000000000000000000000000001"
7955
7956
7957 set runq {}
7958 set history {}
7959 set historyindex 0
7960 set fh_serial 0
7961 set nhl_names {}
7962 set highlight_paths {}
7963 set searchdirn -forwards
7964 set boldrows {}
7965 set boldnamerows {}
7966 set diffelide {0 0}
7967 set markingmatches 0
7968
7969 set optim_delay 16
7970
7971 set nextviewnum 1
7972 set curview 0
7973 set selectedview 0
7974 set selectedhlview None
7975 set viewfiles(0) {}
7976 set viewperm(0) 0
7977 set viewargs(0) {}
7978
7979 set cmdlineok 0
7980 set stopped 0
7981 set stuffsaved 0
7982 set patchnum 0
7983 set lookingforhead 0
7984 set localirow -1
7985 set localfrow -1
7986 set lserial 0
7987 setcoords
7988 makewindow
7989 # wait for the window to become visible
7990 tkwait visibility .
7991 wm title . "[file tail $argv0]: [file tail [pwd]]"
7992 readrefs
7993
7994 if {$cmdline_files ne {} || $revtreeargs ne {}} {
7995     # create a view for the files/dirs specified on the command line
7996     set curview 1
7997     set selectedview 1
7998     set nextviewnum 2
7999     set viewname(1) "Command line"
8000     set viewfiles(1) $cmdline_files
8001     set viewargs(1) $revtreeargs
8002     set viewperm(1) 0
8003     addviewmenu 1
8004     .bar.view entryconf Edit* -state normal
8005     .bar.view entryconf Delete* -state normal
8006 }
8007
8008 if {[info exists permviews]} {
8009     foreach v $permviews {
8010         set n $nextviewnum
8011         incr nextviewnum
8012         set viewname($n) [lindex $v 0]
8013         set viewfiles($n) [lindex $v 1]
8014         set viewargs($n) [lindex $v 2]
8015         set viewperm($n) 1
8016         addviewmenu $n
8017     }
8018 }
8019 getcommits