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