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