gitk

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