gitk

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