git.oblomov.eu Git - git/blob - gitk

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