gitk

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