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