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