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