gitk

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