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